Pileus Git - ~andy/fetchmail/blob - dist-tools/manServer.pl

   1 #!/usr/bin/perl -T
   2
   3 # manServer - Unix man page to HTML converter
   4 # Rolf Howarth, rolf@squarebox.co.uk
   5 # Version 1.07  16 July 2001
   6 # Version 1.07+ma1 2006-03-31 Matthias Andree
   7 #                             add trailing slash of URLs
   8 #                             support https, too
   9
  10 $version = "1.07+ma1";
  11 $manServerUrl = "<A HREF=\"http://www.squarebox.co.uk/users/rolf/download/manServer.shtml\">manServer $version</A>";
  12
  13 use Socket;
  14
  15 $ENV{'PATH'} = "/bin:/usr/bin";
  16
  17 initialise();
  18 $request = shift @ARGV;
  19 # Usage: manServer [-dn] filename | manServer [-s port]
  20
  21 $root = "";
  22 $cgiMode = 0;
  23 $bodyTag = "BODY bgcolor=#F0F0F0 text=#000000 link=#0000ff vlink=#C000C0 alink=#ff0000";
  24
  25 if ($ENV{'GATEWAY_INTERFACE'} ne "")
  26 {
  27         *OUT = *STDOUT;
  28         open(LOG, ">>/tmp/manServer.log");
  29         chmod(0666, '/tmp/manServer.log');
  30         $root = $ENV{'SCRIPT_NAME'};
  31         $url = $ENV{'PATH_INFO'};
  32         if ($ENV{'REQUEST_METHOD'} eq "POST")
  33                 { $args = <STDIN>; chop $args; }
  34         else
  35                 { $args = $ENV{'QUERY_STRING'}; }
  36         $url .= "?".$args if ($args);
  37         $cgiMode = 1;
  38         $date = &fmtTime(time);
  39         $remoteHost = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'};
  40         $referer = $ENV{'HTTP_REFERER'};
  41         $userAgent = $ENV{'HTTP_USER_AGENT'};
  42         print LOG "$date\t$remoteHost\t$url\t$referer\t$userAgent\n";
  43         processRequest($url);
  44 }
  45 elsif ($request eq "-s" || $request eq "")
  46 {
  47         *LOG = *STDERR;
  48         startServer();
  49 }
  50 else
  51 {
  52         $cmdLineMode = 1;
  53         if ($request =~ m/^-d(\d)/)
  54         {
  55                 $debug = $1;
  56                 $request = shift @ARGV;
  57         }
  58         *OUT = *STDOUT;
  59         *LOG = *STDERR;
  60         $file = findPage($request);
  61         man2html($file);
  62 }
  63
  64 exit(0);
  65
  66
  67 ##### Mini HTTP Server ####
  68
  69 sub startServer
  70 {
  71         ($port) = @ARGV;
  72         $port = 8888 unless $port;
  73
  74         $sockaddr = 'S n a4 x8';
  75
  76         ($name, $aliases, $proto) = getprotobyname('tcp');
  77         ($name, $aliases, $port) = getservbyname($port, 'tcp')
  78                         unless $port =~ /^\d+$/;
  79
  80         while(1)
  81         {
  82                 $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
  83
  84                 select(NS); $| = 1; select(stdout);
  85
  86                 socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
  87                 if (bind(S, $this))
  88                 {
  89                         last;
  90                 }
  91                 else
  92                 {
  93                         print STDERR "Failed to bind to port $port: $!\n";
  94                         ++$port;
  95                 }
  96         }
  97
  98         listen(S, 5) || die "connect: $!";
  99
 100         select(S); $| = 1; select(stdout);
 101
 102         while(1)
 103         {
 104                 print LOG "Waiting for connection on port $port\n";
 105                 ($addr = accept(NS,S)) || die $!;
 106                 #print "accept ok\n";
 107
 108                 ($af,$rport,$inetaddr) = unpack($sockaddr,$addr);
 109                 @inetaddr = unpack('C4',$inetaddr);
 110                 print LOG "Got connection from ", join(".",@inetaddr), "\n";
 111
 112                 while (<NS>)
 113                 {
 114                         if (m/^GET (\S+)/) { $url = $1; }
 115                         last if (m/^\s*$/);
 116                 }
 117                 *OUT = *NS;
 118                 processRequest($url);
 119                 close NS ;
 120         }
 121 }
 122
 123
 124 sub processRequest
 125 {
 126         $url = $_[0];
 127         print LOG "Request = $url, root = $root\n";
 128
 129         if ( ($url =~ m/^([^?]*)\?(.*)$/) || ($url =~ m/^([^&]*)&(.*)$/) )
 130         {
 131                 $request = $1;
 132                 $args = $2;
 133         }
 134         else
 135         {
 136                 $request = $url;
 137                 $args = "";
 138         }
 139
 140         @params = split(/[=&]/, $args);
 141         for ($i=0; $i<=$#params; ++$i)
 142         {
 143                 $params[$i] =~ tr/+/ /;
 144                 $params[$i] =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C",hex($1))/eg;
 145         }
 146         %params = @params;
 147
 148         $request = $params{'q'} if ($params{'q'});
 149         $searchType = $params{'t'};
 150         $debug = $params{'d'};
 151
 152         $processed = 0;
 153         $file = "";
 154
 155         if ($searchType)
 156         {
 157                 print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode);
 158                 print OUT "Content-type: text/html\n\n";
 159                 print OUT "<H1>Searching not yet implemented</H1>\n";
 160                 print LOG "Searching not implemented\n";
 161                 $processed = 1;
 162         }
 163         elsif ($request eq "/" || $request eq "")
 164         {
 165                 print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode);
 166                 print OUT "Content-type: text/html\n\n";
 167                 print LOG "Home page\n";
 168                 homePage();
 169                 $processed = 1;
 170         }
 171         elsif ($request =~ m,^/.*/$,)
 172         {
 173                 print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode);
 174                 print OUT "Content-type: text/html\n\n";
 175                 print LOG "List directory\n";
 176                 listDir($request);
 177                 $processed = 1;
 178         }
 179         elsif (-f $request || -f "$request.gz" || -f "$request.bz2")
 180         {
 181                 # Only allow fully specified files if they're in our manpath
 182                 foreach $md (@manpath)
 183                 {
 184                         $dir = $md;
 185                         if (substr($request,0,length($dir)) eq $dir)
 186                         {
 187                                 print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode);
 188                                 print OUT "Content-type: text/html\n\n";
 189                                 man2html($request);
 190                                 $processed = 1;
 191                                 last;
 192                         }
 193                 }
 194         }
 195         else
 196         {
 197                 $file = findPage($request);
 198                 if (@multipleMatches)
 199                 {
 200                         print OUT "HTTP/1.0 200 Ok\n" unless ($cgiMode);
 201                         print OUT "Content-type: text/html\n\n";
 202                         print LOG "Multiple matches\n";
 203                         printMatches();
 204                         $processed = 1;
 205                 }
 206                 elsif ($file)
 207                 {
 208                         print OUT "HTTP/1.0 301 Redirected\n" unless ($cgiMode);
 209                         $file .= "&d=$debug" if ($debug);
 210                         print OUT "Location: $root$file\n\n";
 211                         print LOG "Redirect to $root$file\n";
 212                         $processed = 1;
 213                 }
 214         }
 215
 216         unless ($processed)
 217         {
 218                 print OUT "HTTP/1.0 404 Not Found\n" unless ($cgiMode);
 219                 print OUT "Content-type: text/html\n\n";
 220                 print OUT "<HTML><HEAD>\n<TITLE>Not Found</TITLE>\n<$bodyTag>\n";
 221                 print OUT "<CENTER><H1><HR>Not Found<HR></H1></CENTER>\nFailed to find man page /$request\n";
 222                 print OUT "<P><HR><P><A HREF=\"$root/\">Main Index</A>\n</HTML>\n";
 223                 print STDERR "Failed to find /$request\n" unless ($cgiMode);
 224         }
 225 }
 226
 227 sub homePage
 228 {
 229         print OUT "<HTML><HEAD><TITLE>Manual Pages - Main Index</TITLE>
 230 </HEAD><$bodyTag><CENTER><H1><HR><I>Manual Reference Pages</I> - Main Index<HR></H1></CENTER>
 231 <FORM ACTION=\"$root/\" METHOD=get>\n";
 232         $uname = `uname -s -r`;
 233         if (! $?)
 234         {
 235                 $hostname = `hostname`;
 236                 print OUT "<B>$uname pages on $hostname</B><P>\n";
 237         }
 238         # print OUT "<SELECT name=t> <OPTION selected value=0>Command name
 239         # <OPTION value=1>Keyword search <OPTION value=2>Full text search</SELECT>\n";
 240         print OUT "Command name: <INPUT name=q size=20> <INPUT type=submit value=\"Show Page\"> </FORM><P>\n";
 241         loadManDirs();
 242         foreach $dir (@mandirs)
 243         {
 244                 ($section) = ($dir =~ m/man([0-9A-Za-z]+)$/);
 245                 print OUT "<A HREF=\"$root$dir/\">$dir" ;
 246                 print OUT "- <I>$sectionName{$section}</I>" if ($sectionName{$section});
 247                 print OUT "</A><BR>\n";
 248         }
 249         print OUT "<P><HR><P><FONT SIZE=-1>Generated by $manServerUrl from local unix man pages.</FONT>\n</BODY></HTML>\n";
 250 }
 251
 252 sub listDir
 253 {
 254         foreach $md (@manpath)
 255         {
 256                 $dir = $md;
 257                 if (substr($request,0,length($dir)) eq $dir)
 258                 {
 259                         $request =~ s,/$,,;
 260                         ($section) = ($request =~ m/man([0-9A-Za-z]+)$/);
 261                         $sectionName = $sectionName{$section};
 262                         $sectionName = "Manual Reference Pages" unless ($sectionName);
 263                         print OUT "<HTML><HEAD><TITLE>Contents of $request</TITLE></HEAD>\n<$bodyTag>\n";
 264                         print OUT "<CENTER><H1><HR><NOBR><I>$sectionName</I></NOBR> - <NOBR>Index of $request</NOBR><HR></H1></CENTER>\n";
 265                         print OUT "<FORM ACTION=\"$root/\" METHOD=get>\n";
 266                         print OUT "Command name: <INPUT name=q size=20> <INPUT type=submit value=\"Show Page\"> </FORM><P>\n";
 267
 268                         if (opendir(DIR, $request))
 269                         {
 270                                 @files = sort readdir DIR;
 271                                 foreach $f (@files)
 272                                 {
 273                                         next if ($f eq "." || $f eq ".." || $f !~ m/\./);
 274                                         $f =~ s/\.(gz|bz2)$//;
 275                                         # ($name) = ($f =~ m,/([^/]*)$,);
 276                                         print OUT "<A HREF=\"$root$request/$f\">$f</A>&nbsp;\n";
 277                                 }
 278                                 closedir DIR;
 279                         }
 280                         print OUT "<P><A HREF=\"$root/\">Main Index</A>\n</HTML>\n";
 281                         print OUT "<P><HR><P><FONT SIZE=-1>Generated by $manServerUrl from local unix man pages.</FONT>\n</BODY></HTML>\n";
 282                         return;
 283                 }
 284         }
 285         print OUT "<H1>Directory $request not known</H1>\n";
 286 }
 287
 288 sub printMatches
 289 {
 290         print OUT "<HTML><HEAD><TITLE>Ambiguous Request '$request'</TITLE></HEAD>\n<$bodyTag>\n";
 291         print OUT "<CENTER><H1><HR>Ambiguous Request '$request'<HR></H1></CENTER>\nPlease select one of the following pages:<P><BLOCKQUOTE>";
 292         foreach $f (@multipleMatches)
 293         {
 294                 print OUT "<A HREF=\"$root$f\">$f</A><BR>\n";
 295         }
 296         print OUT "</BLOCKQUOTE><HR><P><A HREF=\"$root/\">Main Index</A>\n</HTML>\n";
 297 }
 298
 299
 300 ##### Process troff input using man macros into HTML #####
 301
 302 sub man2html
 303 {
 304         $file = $_[0];
 305         $srcfile = $file;
 306         $zfile = $file;
 307         if (! -f $file)
 308         {
 309                 if (-f "$file.gz")
 310                 {
 311                         $zfile = "$file.gz";
 312                         $zcat = "/usr/bin/zcat";
 313                         $zcat = "/bin/zcat" unless (-x $zcat);
 314                         $srcfile = "$zcat $zfile |";
 315                         $srcfile =~ m/^(.*)$/;
 316                         $srcfile = $1;  # untaint
 317                 }
 318                 elsif (-f "$file.bz2")
 319                 {
 320                         $zfile = "$file.bz2";
 321                         $srcfile = "/usr/bin/bzcat $zfile |";
 322                         $srcfile =~ m/^(.*)$/;
 323                         $srcfile = $1;  # untaint
 324                 }
 325         }
 326         print LOG "man2html $file\n";
 327         $foundNroffTag = 0;
 328         loadContents($file);
 329         unless (open(SRC, $srcfile))
 330         {
 331                 print OUT "<H1>Failed to open $file</H1>\n";
 332                 print STDERR "Failed to open $srcfile\n";
 333                 return;
 334         }
 335         ($dir,$page,$sect) = ($file =~ m,^(.*)/([^/]+)\.([^.]+)$,);
 336         $troffTable = 0;
 337         %macro = ();
 338         %renamedMacro = ();
 339         %deletedMacro = ();
 340         @indent = ();
 341         @tabstops = ();
 342         $indentLevel = 0;
 343         $prevailingIndent = 6;
 344         $trapLine = 0;
 345         $blockquote = 0;
 346         $noSpace = 0;
 347         $firstSection = 0;
 348         $eqnStart = "";
 349         $eqnEnd = "";
 350         $eqnMode = 0;
 351         %eqndefs = ();
 352         $defaultNm = "";
 353         $title = $file;
 354         $title = "Manual Page - $page($sect)" if ($page && $sect);
 355
 356         $_ = getLine();
 357         if (m/^.so (man.*)$/)
 358         {
 359                 # An .so include on the first line only is replaced by the referenced page.
 360                 # (See elsewhere for processing of included sections that occur later in document.)
 361                 man2html("$dir/../$1");
 362                 return;
 363         }
 364
 365         $perlPattern = "";
 366         if ($file =~ m/perl/)
 367         {
 368                 &loadPerlPages();
 369                 $perlPattern = join('|', grep($_ ne $page, keys %perlPages));
 370         }
 371
 372         print OUT "<HTML><HEAD>\n<TITLE>$title</TITLE>\n<$bodyTag><A NAME=top></A>\n";
 373
 374         if ($foundNroffTag)
 375         {
 376                 do
 377                 {
 378                         preProcessLine();
 379                         processLine();
 380                 }
 381                 while(getLine());
 382                 endNoFill();
 383                 endParagraph();
 384         }
 385         else
 386         {
 387                 # Special case where input is not nroff at all but is preformatted text
 388                 $sectionName = "Manual Reference Pages";
 389                 $sectionNumber = $sect;
 390                 $left = "Manual Page";
 391                 $right = "Manual Page";
 392                 $macroPackage = "(preformatted text)";
 393                 $pageName = "$page($sect)";
 394                 $saveCurrentLine = $_;
 395                 outputPageHead();
 396                 $_ = $saveCurrentLine;
 397                 print OUT "<PRE>\n";
 398                 do
 399                 {
 400                         print OUT $_;
 401                 }
 402                 while(getLine());
 403                 print OUT "</PRE>\n";
 404         }
 405         outputPageFooter();
 406 }
 407
 408 sub outputPageHead
 409 {
 410         plainOutput( "<CENTER>\n" );
 411         outputLine( "<H1><HR><I>$sectionName &nbsp;-&nbsp;</I><NOBR>$pageName</NOBR><HR></H1>\n" );
 412         plainOutput( "</CENTER>\n" );
 413 }
 414
 415 sub outputPageFooter
 416 {
 417         if ($pageName)
 418         {
 419                 unless ($cmdLineMode)
 420                 {
 421                         plainOutput( "<FORM ACTION=\"$root/\" METHOD=get>\n" );
 422                         plainOutput( "Jump to page &nbsp;<INPUT name=q size=12>&nbsp; or go to <A HREF=#top>Top of page</A>&nbsp;|&nbsp;\n" );
 423                         plainOutput( "<A HREF=\"$root$dir/\">Section $sectionNumber</A>&nbsp;|&nbsp;\n" );
 424                         plainOutput( "<A HREF=\"$root/\">Main Index</A>.\n" );
 425                         plainOutput( "<FORM>\n" );
 426                 }
 427                 endBlockquote();
 428                 outputLine("<P><HR>\n<TABLE width=100%><TR> <TD width=33%><I>$left</I></TD> <TD width=33% align=center>$pageName</TD> <TD align=right width=33%><I>$right</I></TD> </TR></TABLE>");
 429         }
 430         plainOutput("<FONT SIZE=-1>Generated by $manServerUrl from $zfile $macroPackage.</FONT>\n</BODY></HTML>\n");
 431 }
 432
 433 sub outputContents
 434 {
 435         print OUT "<A name=contents></A><H3>CONTENTS</H3></A>\n";
 436         blockquote();
 437         for ($id=1; $id<=$#contents; ++$id)
 438         {
 439                 $name = $contents[$id];
 440                 $pre = "";
 441                 $pre = "&nbsp; &nbsp; &nbsp;" if ($name =~ m/^ /);
 442                 $pre .= "&nbsp; &nbsp; &nbsp;" if ($name =~ m/^  /);
 443                 $name =~ s,^\s+,,;
 444                 next if ($name eq "" || $name =~ m,^/,);
 445                 unless ($name =~ m/[a-z]/)
 446                 {
 447                         $name = "\u\L$name";
 448                         $name =~ s/ (.)/ \u\1/g;
 449                 }
 450                 outputLine("$pre<A HREF=#$id>$name</A><BR>\n");
 451         }
 452         endBlockquote();
 453 }
 454
 455 # First pass to extract table of contents
 456 sub loadContents
 457 {
 458         @contents = ();
 459         %contents = ();
 460         # print STDERR "SRCFILE = $srcfile\n";
 461         open(SRC, $srcfile) || return;
 462         while (<SRC>)
 463         {
 464                 preProcessLine();
 465                 $foundNroffTag = $foundNroffTag || (m/^\.(\\\"|TH|so) /);
 466                 if (m/^\.(S[HShs]) ([A-Z].*)\s*$/)
 467                 {
 468                         $foundNroffTag = 1;
 469                         $c = $1;
 470                         $t = $2;
 471                         $t =~ s/"//g;
 472                         $id = @contents;
 473                         if ($c eq "SH" || $c eq "Sh")
 474                         {
 475                                 push(@contents, $t);
 476                         }
 477                         elsif ($t =~ m/\\f/)
 478                         {
 479                                 $t =~ s/\\f.//g;
 480                                 push(@contents, "  $t");
 481                         }
 482                         else
 483                         {
 484                                 push(@contents, " $t");
 485                         }
 486                         $contents{"\U$t"} = $id;
 487                 }
 488         }
 489         close SRC;
 490 }
 491
 492 # Preprocess $_
 493 sub preProcessLine
 494 {
 495         # Remove spurious white space to canonicise the input
 496         chop;
 497         $origLine = $_;
 498         s, $,,g;
 499         s,^',.,;        # treat non breaking requests as if there was a dot
 500         s,^\.\s*,\.,;
 501
 502         if ($eqnMode == 1)
 503         {
 504                 if (m/$eqnEnd/)
 505                 {
 506                         s,^(.*?)$eqnEnd,&processEqnd($1),e;
 507                         $eqnMode = 0;
 508                 }
 509                 else
 510                 {
 511                         &processEqns($_);
 512                 }
 513         }
 514         if ($eqnStart && $eqnMode==0)
 515         {
 516                 s,$eqnStart(.*?)$eqnEnd,&processEqnd($1),ge;
 517                 if (m/$eqnStart/)
 518                 {
 519                         s,$eqnStart(.*)$,&processEqns($1),e;
 520                         $eqnMode = 1;
 521                 }
 522         }
 523
 524         # XXX Note: multiple levels of escaping aren't handled properly, eg. \\*.. as a macro argument
 525         # should get interpolated as string but ends up with a literal '\' being copied through to output.
 526         s,\\\\\*q,&#34;,g; # treat mdoc \\*q as special case
 527
 528         s,\\\\,_DBLSLASH_,g;
 529         s,\\ ,_SPACE_,g;
 530         s,\s*\\".*$,,;
 531         s,\\$,,;
 532
 533         # Then apply any variable substitutions and escape < and >
 534         # (which has to be done before we start inserting tags...)
 535         s,\\\*\((..),$vars{$1},ge;
 536         s/\\\*([*'`,^,:~].)/$vars{$1}||"\\*$1"/ge;
 537         s,\\\*(.),$vars{$1},ge;
 538         # Expand special characters for the first time (eg. \(<-
 539         s,\\\((..),$special{$1}||"\\($1",ge;
 540         s,<,&lt;,g;
 541         s,>,&gt;,g;
 542
 543         # Interpolate width and number registers
 544         s,\\w(.)(.*?)\1,&width($2),ge;
 545         s,\\n\((..),&numreg($1),ge;
 546         s,\\n(.),&numreg($1),ge;
 547 }
 548
 549 # Undo slash escaping, normally done at output stage, also in macro defn
 550 sub postProcessLine
 551 {
 552         s,_DBLSLASH_,\\,g;
 553         s,_SPACE_, ,g;
 554 }
 555
 556 # Rewrite the line, expanding escapes such as font styles, and output it.
 557 # The line may be a plain text troff line, or it might be the expanded output of a
 558 # macro in which case some HTML tags may already have been inserted into the text.
 559 sub outputLine
 560 {
 561         $_ = $_[0];
 562
 563         print OUT "<!-- Output: \"$_\" -->\n" if ($debug>1);
 564
 565         if ($needBreak)
 566         {
 567                 plainOutput("<!-- Need break --><BR>\n");
 568                 lineBreak();
 569         }
 570         if ($textSinceBreak && !$noFill && $_ =~ m/^\s/)
 571         {
 572                 plainOutput("<BR>\n");
 573                 lineBreak();
 574         }
 575
 576         s,\\&\.,&#46;,g;    # \&. often used to escape dot at start of line
 577         s,\\\.,&#46;,g;
 578         s,\\\^,,g;
 579         s,\\\|,,g;
 580         s,\\c,,g;
 581         s,\\0,&nbsp;,g;
 582         s,\\t,\t,g;
 583
 584         s,\\%,&nbsp;,g;
 585         s,\\{,,g;
 586         s,\\},,g;
 587         s,\\$,,g;
 588
 589         s,\\e,&#92;,g;
 590         s,\\([-+_~#[]),\1,g;
 591
 592         # Can't implement local motion tags
 593         s,\\[hv](.).*?\1,,g;
 594         s,\\z,,g;
 595
 596         # Font changes, super/sub-scripts and font size changes
 597         s,\\(f[^(]|f\(..|u|d|s[-+]?\d),&inlineStyle($1),ge;
 598
 599         # Overstrike
 600         if (m/\\o/)
 601         {
 602                 # handle a few special accent cases we know how to deal with
 603                 s,\\o(.)([aouAOU])"\1,\\o\1\2:\1,g;
 604                 s,\\o(.)(.)\\(.)\1,\\o\1\2\3\1,g;
 605                 s;\\o(.)([A-Za-z])(['`:,^~])\1;\\o\1\3\2\1;g;
 606                 #s,\\o(.)(.*?)\1,"<BLINK>".($vars{$2}||$2)."</BLINK>",ge;
 607                 s,\\o(.)(.*?)\1,$vars{$2}||$2,ge;
 608         }
 609         # Bracket building (ignore)
 610         s,\\b(.)(.*?)\1,\2,g;
 611
 612         s,\\`,&#96;,g;
 613         s,\\',&#39;,g;
 614         s,',&#146;,g;
 615         s,`,&#145;,g;
 616
 617         # Expand special characters introduced by eqn
 618         s,\\\((..),$special{$1}||"\\($1",ge;
 619         s,\\\((..),<BLINK>\\($1</BLINK>,g unless (m,^\.,);
 620
 621         # Don't know how to handle other escapes
 622         s,(\\[^&]),<BLINK>\1</BLINK>,g unless (m,^\.,);
 623
 624         postProcessLine();
 625
 626         # Insert links for http, ftp and mailto URLs
 627         # Recognised URLs are sequence of alphanumerics and special chars like / and ~
 628         # but must finish with an alphanumeric rather than punctuation like "."
 629         s,\b(https?://[-\w/~:@.%#+$?=]+[\w/]),<A HREF=\"\1\">\1</A>,g;
 630         s,\b(ftp://[-\w/~:@.%#+$?=]+),<A HREF=\"\1\">\1</A>,g;
 631         s,([-_A-Za-z0-9.]+@[A-Za-z][-_A-Za-z0-9]*\.[-_A-Za-z0-9.]+),<A HREF=\"mailto:\1\">\1</A>,g;
 632
 633         # special case for things like 'perlre' as it's so useful but the
 634         # pod-generated pages aren't very parser friendly...
 635         if ($perlPattern && ! m/<A HREF/i)
 636         {
 637                 s,\b($perlPattern)\b,<A HREF=\"$root$perlPages{$1}\">\1</A>,g;
 638         }
 639
 640         # Do this late so \& can be used to suppress conversion of URLs etc.
 641         s,\\&,,g;
 642
 643         # replace tabs with spaces to next multiple of 8
 644         if (m/\t/)
 645         {
 646                 $tmp = $_;
 647                 $tmp =~ s/<[^>]*>//g;
 648                 $tmp =~ s/&[^;]*;/@/g;
 649                 @tmp = split(/\t/, $tmp);
 650                 $pos = 0;
 651                 for ($i=0; $i<=$#tmp; ++$i)
 652                 {
 653                         $pos += length($tmp[$i]);
 654                         $tab[$i] = 0;
 655                         $tab[$i] = 8 - $pos%8 unless (@tabstops);
 656                         foreach $ts (@tabstops)
 657                         {
 658                                 if ($pos < $ts)
 659                                 {
 660                                         $tab[$i] = $ts-$pos;
 661                                         last;
 662                                 }
 663                         }
 664                         $pos += $tab[$i];
 665                 }
 666                 while (m/\t/)
 667                 {
 668                         s,\t,"&nbsp;" x (shift @tab),e;
 669                 }
 670         }
 671
 672         $textSinceBreak = $_ unless ($textSinceBreak);
 673         print OUT $_;
 674 }
 675
 676 # Output a line consisting purely of HTML tags which shouldn't be regarded as
 677 # a troff output line.
 678 sub plainOutput
 679 {
 680         print OUT $_[0];
 681 }
 682
 683
 684 # Output the original line for debugging
 685 sub outputOrigLine
 686 {
 687         print OUT "<!-- $origLine -->\n";
 688 }
 689
 690 # Use this to read the next input line (buffered to implement lookahead)
 691 sub getLine
 692 {
 693         $lookaheadPtr = 0;
 694         if (@lookahead)
 695         {
 696                 $_ =  shift @lookahead;
 697                 return $_;
 698         }
 699         $_ = <SRC>;
 700 }
 701
 702 # Look ahead to peek at the next input line
 703 sub _lookahead
 704 {
 705         # set lookaheadPtr to 0 to re-read the lines we've looked ahead at
 706         if ($lookaheadPtr>=0 && $lookaheadPtr <= $#lookahead)
 707         {
 708                 return $lookahead[$lookaheadPtr++];
 709         }
 710         $lookaheadPtr = -1;
 711         $ll = <SRC>;
 712         push(@lookahead, $ll);
 713         return $ll;
 714 }
 715
 716 # Consume the last line that was returned by lookahead
 717 sub consume
 718 {
 719         --$lookaheadPtr;
 720         if ($lookaheadPtr>=0 && $lookaheadPtr <= $#lookahead)
 721         {
 722                 $removed = $lookahead[$lookaheadPtr];
 723                 @lookahead = (@lookahead[0..$lookaheadPtr-1],@lookahead[$lookaheadPtr+1..$#lookahead]);
 724         }
 725         else
 726         {
 727                 $removed = pop @lookahead;
 728         }
 729         chop $removed;
 730         plainOutput("<!-- Consumed $removed -->\n");
 731 }
 732
 733 # Look ahead skipping comments and other common non-text tags
 734 sub lookahead
 735 {
 736         $ll = _lookahead();
 737         while ($ll =~ m/^\.(\\"|PD|IX|ns)/)
 738         {
 739                 $ll = _lookahead();
 740         }
 741         return $ll;
 742 }
 743
 744 # Process $_, expaning any macros into HTML and calling outputLine().
 745 # If necessary, this method can read more lines of input from <SRC> (.ig & .de)
 746 # The following state variables are used:
 747 # ...
 748 sub processLine
 749 {
 750         $doneLine = 1;  # By default, this counts as a line for trap purposes
 751
 752         s,^\.if t ,,;
 753         s,^\.el ,,;             # conditions assumed to evaluate false, so else must be true...
 754
 755         if ($troffTable)
 756         {
 757                 processTable();
 758         }
 759         elsif ($eqnMode == 2)
 760         {
 761                 plainOutput("<!-- $_ -->\n");
 762                 processEqns($_);
 763         }
 764         elsif (m/^\./)
 765         {
 766                 processMacro();
 767         }
 768         else
 769         {
 770                 processPlainText();
 771         }
 772         if ($doneLine)
 773         {
 774                 # Called after processing (most) input lines to decrement trapLine. This is needed
 775                 # to implement the .it 1 trap after one line for .TP, where the first line is outdented
 776                 if ($trapLine > 0)
 777                 {
 778                         --$trapLine;
 779                         if ($trapLine == 0)
 780                         {
 781                                 &$trapAction;
 782                         }
 783                 }
 784         }
 785 }
 786
 787
 788 # Process plain text lines
 789 sub processPlainText
 790 {
 791         if ($_ eq "")
 792         {
 793                 lineBreak();
 794                 plainOutput("<P>\n");
 795                 return;
 796         }
 797
 798         s,(\\f[23BI])([A-Z].*?)(\\f.),$1.($contents{"\U$2"}?"<A HREF=#".$contents{"\U$2"}.">$2</A>":$2).$3,ge;
 799
 800         if ($currentSection eq "SEE ALSO" && ! $cmdLineMode)
 801         {
 802                 # Some people don't use BR or IR for see also refs
 803                 s,(^|\s)([-.A-Za-z_0-9]+)\s?\(([0-9lL][0-9a-zA-Z]*)\),\1<A HREF=\"$root/$2.$3\">$2($3)</A>,g;
 804         }
 805         outputLine("$_\n");
 806 }
 807
 808
 809 # Process macros and built-in directives
 810 sub processMacro
 811 {
 812         outputOrigLine();
 813
 814         # Place macro arguments (space delimited unless within ") into @p
 815         # Remove " from $_, place command in $c, remainder in $joined
 816
 817         @p = grep($_ !~ m/^\s*$/, split(/("[^"]*"|\s+)/) );
 818         grep(s/"//g, @p);
 819         $_ = join(" ", @p);
 820         $p[0] =~ s/^\.//;
 821         $c = $p[0];
 822         $joined = join(" ", @p[1..$#p]);
 823         $joined2 = join(" ", @p[2..$#p]);
 824         $joined3 = join(" ", @p[3..$#p]);
 825
 826         if ($macro{$c})                         # Expand macro
 827         {
 828                 # Get full macro text
 829                 $macro = $macro{$c};
 830                 # Interpolate arguments
 831                 $macro =~ s,\\\$(\d),$p[$1],ge;
 832                 #print OUT "<!-- Expanding $c to\n$macro-->\n";
 833                 foreach $_ (split(/\n/, $macro))
 834                 {
 835                         $_ .= "\n";
 836                         preProcessLine();
 837                         processLine();
 838                 }
 839                 $doneLine = 0;
 840                 return;
 841         }
 842         elsif ($renamedMacro{$c})
 843         {
 844                 $c = $renamedMacro{$c};
 845         }
 846
 847         if ($c eq "ds")                 # Define string
 848         {
 849                 $vars{$p[1]} = $joined2;
 850                 $doneLine = 0;
 851         }
 852         elsif ($c eq "nr")                      # Define number register
 853         {
 854                 $number{$p[1]} = evalnum($joined2);
 855                 $doneLine = 0;
 856         }
 857         elsif ($c eq "ti")                      # Temporary indent
 858         {
 859                 plainOutput("&nbsp; &nbsp;");
 860         }
 861         elsif ($c eq "rm")
 862         {
 863                 $macroName = $p[1];
 864                 if ($macro{$macroName})
 865                 {
 866                         delete $macro{$macroName};
 867                 }
 868                 else
 869                 {
 870                         $deletedMacro{$macroName} = 1;
 871                 }
 872         }
 873         elsif ($c eq "rn")
 874         {
 875                 $oldName = $p[1];
 876                 $newName = $p[2];
 877                 $macro = $macro{$oldName};
 878                 if ($macro)
 879                 {
 880                         if ($newName =~ $reservedMacros && ! $deletedMacro{$newName})
 881                         {
 882                                 plainOutput("<!-- Not overwriting reserved macro '$newName' -->\n");
 883                         }
 884                         else
 885                         {
 886                                 $macro{$newName} = $macro;
 887                                 delete $deletedMacro{$newName};
 888                         }
 889                         delete $macro{$oldName};
 890                 }
 891                 else
 892                 {
 893                         # Support renaming of reserved macros by mapping occurrences of new name
 894                         # to old name after macro expansion so that built in definition is still
 895                         # available, also mark the name as deleted to override reservedMacro checks.
 896                         plainOutput("<!-- Fake renaming reserved macro '$oldName' -->\n");
 897                         $renamedMacro{$newName} = $oldName;
 898                         $deletedMacro{$oldName} = 1;
 899                 }
 900         }
 901         elsif ($c eq "de" || $c eq "ig")        # Define macro or ignore
 902         {
 903                 $macroName = $p[1];
 904                 if ($c eq "ig")
 905                         { $delim = ".$p[1]"; }
 906                 else
 907                         { $delim = ".$p[2]"; }
 908                 $delim = ".." if ($delim eq ".");
 909                 # plainOutput("<!-- Scanning for delimiter $delim -->\n");
 910
 911                 $macro = "";
 912                 $_ = getLine();
 913                 preProcessLine();
 914                 while ($_ ne $delim)
 915                 {
 916                         postProcessLine();
 917                         outputOrigLine();
 918                         $macro .= "$_\n";
 919                         $_ = getLine();
 920                         last if ($_ eq "");
 921                         preProcessLine();
 922                 }
 923                 outputOrigLine();
 924                 # plainOutput("<!-- Found delimiter -->\n");
 925                 if ($c eq "de")
 926                 {
 927                         if ($macroName =~ $reservedMacros && ! $deletedMacro{$macroName})
 928                         {
 929                                 plainOutput("<!-- Not defining reserved macro '$macroName' ! -->\n");
 930                         }
 931                         else
 932                         {
 933                                 $macro{$macroName} = $macro;
 934                                 delete $deletedMacro{$macroName};
 935                         }
 936                 }
 937         }
 938         elsif ($c eq "so")                      # Source
 939         {
 940                 plainOutput("<P>[<A HREF=\"$root$dir/../$p[1]\">Include document $p[1]</A>]<P>\n");
 941         }
 942         elsif ($c eq "TH" || $c eq "Dt")                        # Man page title
 943         {
 944                 endParagraph();
 945                 $sectionNumber = $p[2];
 946                 $sectionName = $sectionName{"\L$sectionNumber"};
 947                 $sectionName = "Manual Reference Pages" unless ($sectionName);
 948                 $pageName = "$p[1] ($sectionNumber)";
 949                 outputPageHead();
 950                 if ($c eq "TH")
 951                 {
 952                         $right = $p[3];
 953                         $left = $p[4];
 954                         $left = $osver unless ($left);
 955                         $macroPackage = "using man macros";
 956                 }
 957                 else
 958                 {
 959                         $macroPackage = "using doc macros";
 960                 }
 961         }
 962         elsif ($c eq "Nd")
 963         {
 964                 outputLine("- $joined\n");
 965         }
 966         elsif ($c eq "SH" || $c eq "SS" || $c eq "Sh" || $c eq "Ss")            # Section/subsection
 967         {
 968                 lineBreak();
 969                 endNoFill();
 970                 endParagraph();
 971                 $id = $contents{"\U$joined"};
 972                 $currentSection = $joined;
 973
 974                 if ($c eq "SH" || $c eq "Sh")
 975                 {
 976                         endBlockquote();
 977                         if ($firstSection++==1) # after first 'Name' section
 978                         {
 979                                 outputContents();
 980                         }
 981                         outputLine( "<A name=$id>\n\n     <H3>$joined</H3>\n\n</A>\n" );
 982                         blockquote();
 983                 }
 984                 elsif ($joined =~ m/\\f/)
 985                 {
 986                         $joined =~ s/\\f.//g;
 987                         $id = $contents{"\U$joined"};
 988                         outputLine( "<A name=$id>\n<H4><I>$joined</I></H4></A>\n" );
 989                 }
 990                 else
 991                 {
 992                         endBlockquote();
 993                         outputLine( "<A name=$id>\n\n    <H4>&nbsp; &nbsp; $joined</H4>\n</A>\n" );
 994                         blockquote();
 995                 }
 996                 lineBreak();
 997         }
 998         elsif ($c eq "TX" || $c eq "TZ")        # Document reference
 999         {
1000                 $title = $title{$p[1]};
1001                 $title = "Document [$p[1]]" unless ($title);
1002                 outputLine( "\\fI$title\\fP$joined2\n" );
1003         }
1004         elsif ($c eq "PD")                      # Line spacing
1005         {
1006                 $noSpace = ($p[1] eq "0");
1007                 $doneLine = 0;
1008         }
1009         elsif ($c eq "TS")                      # Table start
1010         {
1011                 unless ($macroPackage =~ /tbl/)
1012                 {
1013                         if ($macroPackage =~ /eqn/)
1014                                 { $macroPackage =~ s/eqn/eqn & tbl/; }
1015                         else
1016                                 { $macroPackage .= " with tbl support"; }
1017                 }
1018                 resetStyles();
1019                 endNoFill();
1020                 $troffTable = 1;
1021                 $troffSeparator = "\t";
1022                 plainOutput( "<P><BLOCKQUOTE><TABLE bgcolor=#E0E0E0 border=1 cellspacing=0 cellpadding=3>\n" );
1023         }
1024         elsif ($c eq "EQ")                      # Eqn start
1025         {
1026                 unless ($macroPackage =~ /eqn/)
1027                 {
1028                         if ($macroPackage =~ /tbl/)
1029                                 { $macroPackage =~ s/tbl/tbl & eqn/; }
1030                         else
1031                                 { $macroPackage .= " with eqn support"; }
1032                 }
1033                 $eqnMode = 2;
1034         }
1035         elsif ($c eq "ps")                      # Point size
1036         {
1037                 plainOutput(&sizeChange($p[1]));
1038         }
1039         elsif ($c eq "ft")                      # Font change
1040         {
1041                 plainOutput(&fontChange($p[1]));
1042         }
1043         elsif ($c eq "I" || $c eq "B")  # Single word font change
1044         {
1045                 $id = $contents{"\U$joined"};
1046                 if ($id && $joined =~ m/^[A-Z]/)
1047                         { $joined = "<A HREF=#$id>$joined</A>"; }
1048                 outputLine( "\\f$c$joined\\fP " );
1049                 plainOutput("\n") if ($noFill);
1050         }
1051         elsif ($c eq "SM")                      # Single word smaller
1052         {
1053                 outputLine("\\s-1$joined\\s0 ");
1054                 $doneLine = 0 unless ($joined);
1055         }
1056         elsif ($c eq "SB")                      # Single word bold and small
1057         {
1058                 outputLine("\\fB\\s-1$joined\\s0\\fP ");
1059         }
1060         elsif (m/^\.[BI]R (\S+)\s?\(\s?([0-9lL][0-9a-zA-Z]*)\s?\)(.*)$/)
1061         {
1062                 # Special form, .BR is generally used for references to other pages
1063                 # Annoyingly, some people have more than one per line...
1064                 # Also, some people use .IR ...
1065                 for ($i=1; $i<=$#p; $i+=2)
1066                 {
1067                         $pair = $p[$i]." ".$p[$i+1];
1068                         if ($p[$i+1] eq "(")
1069                         {
1070                                 $pair .= $p[$i+2].$p[$i+3];
1071                                 $i += 2;
1072                         }
1073                         if ($pair =~ m/^(\S+)\s?\(\s?([0-9lL][0-9a-zA-Z]*)\s?\)(.*)$/)
1074                         {
1075                                 if ($cmdLineMode)
1076                                         { outputLine( "\\fB$1\\fR($2)$3\n" ); }
1077                                 else
1078                                         { outputLine( "<A HREF=\"$root/$1.$2\">$1($2)</A>$3\n" ); }
1079                         }
1080                         else
1081                                 { outputLine( "$pair\n" ); }
1082                 }
1083         }
1084         elsif ($c eq "BR" || $c eq "BI" || $c eq "IB" ||
1085                    $c eq "IR" || $c eq "RI" || $c eq "RB")
1086         {
1087                 $f1 = (substr($c ,0,1));
1088                 $f2 = (substr($c,1,1));
1089
1090                 # Check if first param happens to be a section name
1091                 $id = $contents{"\U$p[1]"};
1092                 if ($id && $p[1] =~ m/^[A-Z]/)
1093                 {
1094                         $p[1] = "<A HREF=#$id>$p[1]</A>";
1095                 }
1096
1097                 for ($i=1; $i<=$#p; ++$i)
1098                 {
1099                         $f = ($i%2 == 1) ? $f1 : $f2;
1100                         outputLine("\\f$f$p[$i]");
1101                 }
1102                 outputLine("\\fP ");
1103                 plainOutput("\n") if ($noFill);
1104         }
1105         elsif ($c eq "nf" || $c eq "Bd")                        # No fill
1106         {
1107                 startNoFill();
1108         }
1109         elsif ($c eq "fi" || $c eq "Ed")                        # Fill
1110         {
1111                 endNoFill();
1112         }
1113         elsif ($c eq "HP")
1114         {
1115                 $indent = evalnum($p[1]);
1116                 if ($trapOnBreak)
1117                 {
1118                         plainOutput("<BR>\n");
1119                 }
1120                 else
1121                 {
1122                         # Outdent first line, ie. until next break
1123                         $trapOnBreak = 1;
1124                         $trapAction = *trapHP;
1125                         newParagraph($indent);
1126                         plainOutput( "<TD colspan=2>\n" );
1127                         $colState = 2;
1128                 }
1129         }
1130         elsif ($c eq "IP")
1131         {
1132                 $trapOnBreak = 0;
1133                 $tag = $p[1];
1134                 $indent = evalnum($p[2]);
1135                 newParagraph($indent);
1136                 outputLine("<TD$width>\n$tag\n</TD><TD>\n");
1137                 $colState = 1;
1138                 lineBreak();
1139         }
1140         elsif ($c eq "TP")
1141         {
1142                 $trapOnBreak = 0;
1143                 $trapLine = 1;  # Next line is tag, then next column
1144                 $doneLine = 0;  # (But don't count this line)
1145                 $trapAction = *trapTP;
1146                 $indent = evalnum($p[1]);
1147                 $tag = lookahead();
1148                 chop $tag;
1149                 $i = ($indent ? $indent : $prevailingIndent) ;
1150                 $w = width($tag);
1151                 if ($w > $i)
1152                 {
1153                         plainOutput("<!-- Length of tag '$tag' ($w) > indent ($i) -->\n") if ($debug);
1154                         newParagraph($indent);
1155                         $trapAction = *trapHP;
1156                         plainOutput( "<TD colspan=2>\n" );
1157                         $colState = 2;
1158                 }
1159                 else
1160                 {
1161                         newParagraph($indent);
1162                         plainOutput( "<TD$width nowrap>\n" );
1163                         $colState = 0;
1164                 }
1165                 $body = lookahead();
1166                 $lookaheadPtr = 0;
1167                 if ($body =~ m/^\.[HILP]?P/)
1168                 {
1169                         chop $body;
1170                         plainOutput("<!-- Suppressing TP body due to $body -->\n");
1171                         $trapLine = 0;
1172                 }
1173         }
1174         elsif ($c eq "LP" || $c eq "PP" || $c eq "P" || $c eq "Pp")     # Paragraph
1175         {
1176                 $trapOnBreak = 0;
1177                 $prevailingIndent = 6;
1178                 if ($indent[$indentLevel] > 0 && $docListStyle eq "")
1179                 {
1180                         $line = lookahead();
1181                         if ($line =~ m/^\.(TP|IP|HP)/)
1182                         {
1183                                 plainOutput("<!-- suppressed $c before $1 -->\n");
1184                         }
1185                         elsif ($line =~ m/^\.RS/)
1186                         {
1187                                 plainOutput("<P>\n");
1188                         }
1189                         else
1190                         {
1191                                 endRow();
1192                                 $foundTag = "";
1193                                 $lookaheadPtr = 0;
1194                                 do
1195                                 {
1196                                         $line = lookahead();
1197                                         if ($line =~ m/^\.(TP|HP|IP|RS)( \d+)?/)
1198                                         {
1199                                                 $indent = $2;
1200                                                 $indent = $prevailingIndent unless ($2);
1201                                                 if ($indent == $indent[$indentLevel])
1202                                                         { $foundTag = $1; }
1203                                                 $line = "";
1204                                         }
1205                                 }
1206                                 while ($line ne "" && $line !~ m/^\.(RE|SH|SS|PD)/);
1207                                 $lookaheadPtr = 0;
1208                                 if ($foundTag)
1209                                 {
1210                                         plainOutput("<!-- Found tag $foundTag -->\n");
1211                                         plainOutput("<TR><TD colspan=2>\n");
1212                                         $colState = 2;
1213                                 }
1214                                 else
1215                                 {
1216                                         plainOutput("<!-- $c ends table -->\n");
1217                                         setIndent(0);
1218                                 }
1219                         }
1220                 }
1221                 else
1222                 {
1223                         plainOutput("<P>\n");
1224                 }
1225                 lineBreak();
1226         }
1227         elsif ($c eq "br")                      # Break
1228         {
1229                 if ($trapOnBreak)
1230                 {
1231                         # Should this apply to all macros that cause a break?
1232                         $trapOnBreak = 0;
1233                         &$trapAction();
1234                 }
1235                 $needBreak = 1 if ($textSinceBreak);
1236         }
1237         elsif ($c eq "sp")                      # Space
1238         {
1239                 lineBreak();
1240                 plainOutput("<P>\n");
1241         }
1242         elsif ($c eq "RS")                      # Block indent start
1243         {
1244                 if ($indentLevel==0 && $indent[0]==0)
1245                 {
1246                         blockquote();
1247                 }
1248                 else
1249                 {
1250                         $indent = $p[1];
1251                         $indent = $prevailingIndent unless ($indent);
1252                         if ($indent > $indent[$indentLevel] && !$extraIndent)
1253                         {
1254                                 $extraIndent = 1;
1255                                 ++$indentLevel;
1256                                 $indent[$indentLevel] = 0;
1257                                 setIndent($indent-$indent[$indentLevel-1]);
1258                                 plainOutput("<TR><TD$width>&nbsp;</TD><TD>\n");
1259                                 $colState = 1;
1260                         }
1261                         elsif ($indent < $indent[$indentLevel] || $colState==2)
1262                         {
1263                                 endRow();
1264                                 setIndent($indent);
1265                                 plainOutput("<TR><TD$width>&nbsp;</TD><TD>\n");
1266                                 $colState = 1;
1267                         }
1268                         ++$indentLevel;
1269                         $indent[$indentLevel] = 0;
1270                 }
1271                 $prevailingIndent = 6;
1272         }
1273         elsif ($c eq "RE")                      # Block indent end
1274         {
1275                 if ($extraIndent)
1276                 {
1277                         endRow();
1278                         setIndent(0);
1279                         --$indentLevel;
1280                         $extraIndent = 0;
1281                 }
1282                 if ($indentLevel==0)
1283                 {
1284                         endParagraph();
1285                         if ($blockquote>0)
1286                         {
1287                                 plainOutput("</BLOCKQUOTE>\n");
1288                                 --$blockquote;
1289                         }
1290                 }
1291                 else
1292                 {
1293                         endRow();
1294                         setIndent(0);
1295                         --$indentLevel;
1296                 }
1297                 $prevailingIndent = $indent[$indentLevel];
1298                 $prevailingIndent = 6 unless($prevailingIndent);
1299         }
1300         elsif ($c eq "DT")                      # default tabs
1301         {
1302                 @tabstops = ();
1303         }
1304         elsif ($c eq "ta")                      # Tab stops
1305         {
1306                 @tabstops = ();
1307                 for ($i=0; $i<$#p; ++$i)
1308                 {
1309                         $ts = $p[$i+1];
1310                         $tb = 0;
1311                         if ($ts =~ m/^\+/)
1312                         {
1313                                 $tb = $tabstops[$i-1];
1314                                 $ts =~ s/^\+//;
1315                         }
1316                         $ts = evalnum($ts);
1317                         $tabstops[$i] = $tb + $ts;
1318                 }
1319                 plainOutput("<!-- Tabstops set at ".join(",", @tabstops)." -->\n") if ($debug);
1320         }
1321         elsif ($c eq "It")                      # List item (mdoc)
1322         {
1323                 lineBreak();
1324                 if ($docListStyle eq "-tag")
1325                 {
1326                         endRow() unless($multilineIt);
1327                         if ($tagWidth)
1328                         {
1329                                 setIndent($tagWidth);
1330                         }
1331                         else
1332                         {
1333                                 setIndent(6);
1334                                 $width = "";    # let table take care of own width
1335                         }
1336                         if ($p[1] eq "Xo")
1337                         {
1338                                 plainOutput("<TR valign=top><TD colspan=2>");
1339                         }
1340                         else
1341                         {
1342                                 $tag = &mdocStyle(@p[1..$#p]);
1343                                 $body = lookahead();
1344                                 if ($body =~ m/^\.It/)
1345                                         { $multilineItNext = 1; }
1346                                 else
1347                                         { $multilineItNext = 0; }
1348                                 if ($multilineIt)
1349                                 {
1350                                         outputLine("<BR>\n$tag\n");
1351                                 }
1352                                 elsif ($multilineItNext || $tagWidth>0 && width($tag)>$tagWidth)
1353                                 {
1354                                         outputLine("<TR valign=top><TD colspan=2>$tag\n");
1355                                         $colState = 2;
1356                                 }
1357                                 else
1358                                 {
1359                                         outputLine("<TR valign=top><TD>$tag\n");
1360                                         $colState = 1;
1361                                 }
1362                                 if ($multilineItNext)
1363                                 {
1364                                         $multilineIt = 1;
1365                                 }
1366                                 else
1367                                 {
1368                                         $multilineIt = 0;
1369                                         if ($colState==2)
1370                                                 { plainOutput("</TD></TR><TR><TD>&nbsp;</TD><TD>\n"); }
1371                                         else
1372                                                 { plainOutput("</TD><TD>\n"); }
1373                                 }
1374                         }
1375                 }
1376                 else
1377                 {
1378                         plainOutput("<LI>");
1379                 }
1380                 lineBreak();
1381         }
1382         elsif ($c eq "Xc")
1383         {
1384                 if ($docListStyle eq "-tag")
1385                 {
1386                         plainOutput("</TD></TR><TR><TD>&nbsp;</TD><TD>\n");
1387                 }
1388         }
1389         elsif ($c eq "Bl")              # Begin list (mdoc)
1390         {
1391                 push @docListStyles, $docListStyle;
1392                 if ($p[1] eq "-enum")
1393                 {
1394                         plainOutput("<OL>\n");
1395                         $docListStyle = $p[1];
1396                 }
1397                 elsif($p[1] eq "-bullet")
1398                 {
1399                         plainOutput("<UL>\n");
1400                         $docListStyle = $p[1];
1401                 }
1402                 else
1403                 {
1404                         $docListStyle = "-tag";
1405                         if ($p[2] eq "-width")
1406                         {
1407                                 $tagWidth = width($p[3]);
1408                                 if ($tagWidth < 6) { $tagWidth = 6; }
1409                         }
1410                         else
1411                         {
1412                                 $tagWidth = 0;
1413                         }
1414                         $multilineIt = 0;
1415                 }
1416         }
1417         elsif ($c eq "El")              # End list
1418         {
1419                 if ($docListStyle eq "-tag")
1420                 {
1421                         endRow();
1422                         setIndent(0);
1423                 }
1424                 elsif ($docListStyle eq "-bullet")
1425                 {
1426                         plainOutput("</UL>\n");
1427                 }
1428                 else
1429                 {
1430                         plainOutput("</OL>\n");
1431                 }
1432                 $docListStyle = pop @docListStyles;
1433         }
1434         elsif ($c eq "Os")
1435         {
1436                 $right = $joined;
1437         }
1438         elsif ($c eq "Dd")
1439         {
1440                 $left = $joined;
1441         }
1442         elsif ($c eq "Sx")              # See section
1443         {
1444                 $id = $contents{"\U$joined"};
1445                 if ($id && $joined =~ m/^[A-Z]/)
1446                 {
1447                         outputLine("<A HREF=#$id>".&mdocStyle(@p[1..$#p])."</A>\n");
1448                 }
1449                 else
1450                 {
1451                         my $x = &mdocStyle(@p[1..$#p]);
1452                         $x =~ s/^ //;
1453                         outputLine($x."\n");
1454                 }
1455         }
1456         elsif (&mdocCallable($c))
1457         {
1458                 my $x = &mdocStyle(@p);
1459                 $x =~ s/^ //;
1460                 outputLine($x."\n");
1461         }
1462         elsif ($c eq "Bx")
1463         {
1464                 outputLine("<I>BSD $joined</I>\n");
1465         }
1466         elsif ($c eq "Ux")
1467         {
1468                 outputLine("<I>Unix $joined</I>\n");
1469         }
1470         elsif ($c eq "At")
1471         {
1472                 outputLine("<I>AT&T $joined</I>\n");
1473         }
1474         elsif ($c =~ m/[A-Z][a-z]/)             # Unsupported doc directive
1475         {
1476                 outputLine("<BR>.$c $joined\n");
1477         }
1478         elsif ($c eq "")                                # Empty line (eg. troff comment)
1479         {
1480                 $doneLine = 0;
1481         }
1482         else                                            # Unsupported directive
1483         {
1484                 # Unknown macros are ignored, and don't count as a line as far as trapLine goes
1485                 $doneLine = 0;
1486                 plainOutput("<!-- ignored unsupported tag .$c -->\n");
1487         }
1488 }
1489
1490 sub trapTP
1491 {
1492         $lookaheadPtr = 0;
1493         $body = lookahead();
1494         if ($body =~ m/^\.TP/)
1495         {
1496                 consume();
1497                 $trapLine = 1;  # restore TP trap
1498                 $doneLine = 0;  # don't count this line
1499                 plainOutput("<BR>\n");
1500         }
1501         else
1502         {
1503                 plainOutput("</TD><TD valign=bottom>\n");
1504                 $colState = 1;
1505         }
1506         lineBreak();
1507 }
1508
1509 sub trapHP
1510 {
1511         $lookaheadPtr = 0;
1512         $body = lookahead();
1513         if ($body =~ m/^\.([TH]P)/)
1514         {
1515                 consume();
1516                 # Restore appropriate type of trap
1517                 if ($1 eq "TP")
1518                 {
1519                         $trapLine = 1;
1520                         $doneLine = 0;  # don't count this line
1521                 }
1522                 else
1523                 {
1524                         $trapOnBreak = 1;
1525                 }
1526                 plainOutput("<BR>\n");
1527         }
1528         else
1529         {
1530                 plainOutput("</TD></TR><TR valign=top><TD$width>&nbsp;</TD><TD>\n");
1531                 $colState = 1;
1532         }
1533         lineBreak();
1534 }
1535
1536 sub newParagraph
1537 {
1538         $indent = $_[0];
1539         endRow();
1540         startRow($indent);
1541 }
1542
1543 sub startRow
1544 {
1545         $indent = $_[0];
1546         $indent = $prevailingIndent unless ($indent);
1547         $prevailingIndent = $indent;
1548         setIndent($indent);
1549         plainOutput( "<TR valign=top>" );
1550 }
1551
1552 # End an existing HP/TP/IP/RS row
1553 sub endRow
1554 {
1555         if ($indent[$indentLevel] > 0)
1556         {
1557                 lineBreak();
1558                 plainOutput( "</TD></TR>\n" );
1559         }
1560 }
1561
1562 # Called when we output a line break tag. Only needs to be called once if
1563 # calling plainOutput, but should call before and after if using outputLine.
1564 sub lineBreak
1565 {
1566         $needBreak = 0;
1567         $textSinceBreak = 0;
1568 }
1569
1570 # Called to reset all indents and pending paragraphs (eg. at the start of
1571 # a new top level section).
1572 sub endParagraph
1573 {
1574         ++$indentLevel;
1575         while ($indentLevel > 0)
1576         {
1577                 --$indentLevel;
1578                 if ($indent[$indentLevel] > 0)
1579                 {
1580                         endRow();
1581                         setIndent(0);
1582                 }
1583         }
1584 }
1585
1586 # Interpolate a number register (possibly autoincrementing)
1587 sub numreg
1588 {
1589         return 0 + $number{$_[0]};
1590 }
1591
1592 # Evaluate a numeric expression
1593 sub evalnum
1594 {
1595         $n = $_[0];
1596         return "" if ($n eq "");
1597         if ($n =~ m/i$/)        # inches
1598         {
1599                 $n =~ s/i//;
1600                 $n *= 10;
1601         }
1602         return 0+$n;
1603 }
1604
1605 sub setIndent
1606 {
1607         $tsb = $textSinceBreak;
1608         $indent = evalnum($_[0]);
1609         if ($indent==0 && $_[0] !~ m/^0/)
1610         {
1611                 $indent = 6;
1612         }
1613         plainOutput("<!-- setIndent $indent, indent[$indentLevel] = $indent[$indentLevel] -->\n") if ($debug);
1614         if ($indent[$indentLevel] != $indent)
1615         {
1616                 lineBreak();
1617                 if ($indent[$indentLevel] > 0)
1618                 {
1619                         plainOutput("<TR></TR>") unless ($noSpace);
1620                         plainOutput("</TABLE>");
1621                 }
1622                 if ($indent > 0)
1623                 {
1624                         endNoFill();
1625                         $border = "";
1626                         $border = " border=1" if ($debug>2);
1627                         #plainOutput("<P>") unless ($indent[$indentLevel] > 0);
1628                         plainOutput("<TABLE$border");
1629                         # Netscape bug, makes 2 cols same width? : plainOutput("<TABLE$border COLS=2");
1630                         # Overcome some of the vagaries of Netscape tables
1631                         plainOutput(" width=100%") if ($indentLevel>0);
1632                         if ($noSpace)
1633                         {
1634                                 plainOutput(" cellpadding=0 cellspacing=0>\n");
1635                         }
1636                         else
1637                         {
1638                                 plainOutput(" cellpadding=3>".($tsb ? "<!-- tsb: $tsb -->\n<TR></TR><TR></TR>\n" : "\n") );
1639                         }
1640                         #$width = " width=".($indent*5);        # causes text to be chopped if too big
1641                         $percent = $indent;
1642                         if ($indentLevel > 0)
1643                                 { $percent = $indent * 100 / (100-$indentLevel[0]); }
1644                         $width = " width=$percent%";
1645                 }
1646                 $indent[$indentLevel] = $indent;
1647         }
1648 }
1649
1650 # Process mdoc style macros recursively, as one of the macro arguments
1651 # may itself be the name of another macro to invoke.
1652 sub mdocStyle
1653 {
1654         return "" unless @_;
1655         my ($tag, @param) = @_;
1656         my ($rest, $term);
1657
1658         # Don't format trailing punctuation
1659         if ($param[$#param] =~ m/^[.,;:]$/)
1660         {
1661                 $term = pop @param;
1662         }
1663         if ($param[$#param] =~ m/^[)\]]$/)
1664         {
1665                 $term = (pop @param).$term;
1666         }
1667
1668         if ($param[0] =~ m,\\\\,)
1669         {
1670                 print STDERR "$tag: ",join(",", @param),"\n";
1671         }
1672         $rest = &mdocStyle(@param);
1673
1674         if ($tag eq "Op")
1675         {
1676                 $rest =~ s/ //; # remove first space
1677                 return " \\fP[$rest]$term";
1678         }
1679         elsif ($tag eq "Xr")    # cross reference
1680         {
1681                 my $p = shift @param;
1682                 my $url = $p;
1683                 if (@param==1)
1684                 {
1685                         $url .= ".".$param[0];
1686                         $rest = "(".$param[0].")";
1687                 }
1688                 else
1689                 {
1690                         $rest = &mdocStyle(@param);
1691                 }
1692                 if ($cmdLineMode)
1693                 {
1694                         return " <B>".$p."</B>".$rest.$term;
1695                 }
1696                 else
1697                 {
1698                         return " <A HREF=\"".$root."/".$url."\">".$p."</A>".$rest.$term;
1699                 }
1700         }
1701         elsif ($tag eq "Fl")
1702         {
1703                 my ($sofar);
1704                 while (@param)
1705                 {
1706                         $f = shift @param;
1707                         if ($f eq "Ns") # no space
1708                         {
1709                                 chop $sofar;
1710                         }
1711                         elsif (&mdocCallable($f))
1712                         {
1713                                 unshift @param, $f;
1714                                 return $sofar.&mdocStyle(@param).$term;
1715                         }
1716                         else
1717                         {
1718                                 $sofar .= "-<B>$f</B> "
1719                         }
1720                 }
1721                 return $sofar.$term;
1722         }
1723         elsif ($tag eq "Pa" || $tag eq "Er" || $tag eq "Fn" || $tag eq "Dv")
1724         {
1725                 return "\\fC$rest\\fP$term";
1726         }
1727         elsif ($tag eq "Ad" || $tag eq "Ar" || $tag eq "Em" || $tag eq "Fa" || $tag eq "St" ||
1728                 $tag eq "Ft" || $tag eq "Va" || $tag eq "Ev" || $tag eq "Tn" || $tag eq "%T")
1729         {
1730                 return "\\fI$rest\\fP$term";
1731         }
1732         elsif ($tag eq "Nm")
1733         {
1734                 $defaultNm = $param[0] unless ($defaultNm);
1735                 $rest = $defaultNm unless ($param[0]);
1736                 return "\\fB$rest\\fP$term";
1737         }
1738         elsif ($tag eq "Ic" || $tag eq "Cm" || $tag eq "Sy")
1739         {
1740                 return "\\fB$rest\\fP$term";
1741         }
1742         elsif ($tag eq "Ta")            # Tab
1743         {
1744                 # Tabs are used inconsistently so this is the best we can do. Columns won't line up. Tough.
1745                 return "&nbsp; &nbsp; &nbsp; $rest$term";
1746         }
1747         elsif ($tag eq "Ql")
1748         {
1749                 $rest =~ s/ //;
1750                 return "`<TT>$rest</TT>'$term";
1751         }
1752         elsif ($tag eq "Dl")
1753         {
1754                 return "<P>&nbsp; &nbsp; <TT>$rest</TT>$term<P>\n";
1755         }
1756         elsif ($tag =~ m/^[ABDEOPQS][qoc]$/)
1757         {
1758                 $lq = "";
1759                 $rq = "";
1760                 if ($tag =~ m/^A/)
1761                         { $lq = "&lt;"; $rq = "&gt;"; }
1762                 elsif ($tag =~ m/^B/)
1763                         { $lq = "["; $rq = "]"; }
1764                 elsif ($tag =~ m/^D/)
1765                         { $lq = "\""; $rq = "\""; }
1766                 elsif ($tag =~ m/^P/)
1767                         { $lq = "("; $rq = ")"; }
1768                 elsif ($tag =~ m/^Q/)
1769                         { $lq = "\""; $rq = "\""; }
1770                 elsif ($tag =~ m/^S/)
1771                         { $lq = "\\'"; $rq = "\\'"; }
1772                 elsif ($tag =~ m/^O/)
1773                         { $lq = "["; $rq = "]"; }
1774                 if ($tag =~ m/^.o/)
1775                         { $rq = ""; }
1776                 if ($tag =~ m/^.c/)
1777                         { $lq = ""; }
1778                 $rest =~ s/ //;
1779                 return $lq.$rest.$rq.$term ;
1780         }
1781         elsif (&mdocCallable($tag))     # but not in list above...
1782         {
1783                 return $rest.$term;
1784         }
1785         elsif ($tag =~ m/^[.,;:()\[\]]$/)       # punctuation
1786         {
1787                 return $tag.$rest.$term;
1788         }
1789         elsif ($tag eq "Ns")
1790         {
1791                 return $rest.$term;
1792         }
1793         else
1794         {
1795                 return " ".$tag.$rest.$term;
1796         }
1797 }
1798
1799 # Determine if a macro is mdoc parseable/callable
1800 sub mdocCallable
1801 {
1802         return ($_[0] =~ m/^(Op|Fl|Pa|Er|Fn|Ns|No|Ad|Ar|Xr|Em|Fa|Ft|St|Ic|Cm|Va|Sy|Nm|Li|Dv|Ev|Tn|Pf|Dl|%T|Ta|Ql|[ABDEOPQS][qoc])$/);
1803 }
1804
1805
1806 # Estimate the output width of a string
1807 sub width
1808 {
1809         local($word) = $_[0];
1810         $word =~ s,<[/A-Z][^>]*>,,g;            # remove any html tags
1811         $word =~ s/^\.\S+\s//;
1812         $word =~ s/\\..//g;
1813         $x = length($word);
1814         $word =~ s/[ ()|.,!;:"']//g;    # width of punctuation is about half a character
1815         return ($x + length($word)) / 2;
1816 }
1817
1818 # Process a tbl table (between TS/TE tags)
1819 sub processTable
1820 {
1821         if ($troffTable == "1")
1822         {
1823                 @troffRowDefs = ();
1824                 @tableRows = ();
1825                 $hadUnderscore = 0;
1826                 while(1)
1827                 {
1828                         outputOrigLine();
1829                         if (m/;\s*$/)
1830                         {
1831                                 $troffSeparator = quotemeta($1) if (m/tab\s*\((.)\)/);
1832                         }
1833                         else
1834                         {
1835                                 s/\.\s*$//;
1836                                 s/\t/ /g;
1837                                 s/^[^lrcan^t]*//;       # remove any 'modifiers' coming before tag
1838                                 # delimit on tags excluding s (viewed as modifier of previous column)
1839                                 s/([lrcan^t])/\t$1/g;
1840                                 s/^\t//;
1841                                 push @troffRowDefs, $_;
1842                                 last if ($origLine =~ m/\.\s*$/);
1843                         }
1844                         $_ = getLine();
1845                         preProcessLine();
1846                 }
1847                 $troffTable = 2;
1848                 return;
1849         }
1850
1851         s/$troffSeparator/\t/g;
1852         if ($_ eq ".TE")
1853         {
1854                 endTblRow();
1855                 flushTable();
1856                 $troffTable = 0;
1857                 plainOutput("</TABLE></BLOCKQUOTE>\n");
1858         }
1859         elsif ($_ eq ".T&")
1860         {
1861                 endTblRow();
1862                 flushTable();
1863                 $troffTable = 1;
1864         }
1865         elsif (m/[_=]/ && m/^[_=\t]*$/ && $troffCol==0)
1866         {
1867                 if (m/^[_=]$/)
1868                 {
1869                         flushTable();
1870                         plainOutput("<TR></TR><TR></TR>\n");
1871                         $hadUnderscore = 1;
1872                 }
1873                 elsif ($troffCol==0 && @troffRowDefs)
1874                 {
1875                         # Don't output a row, but this counts as a row as far as row defs go
1876                         $rowDef = shift @troffRowDefs;
1877                         @troffColDefs = split(/\t/, $rowDef);
1878                 }
1879         }
1880         elsif (m/^\.sp/ && $troffCol==0 && !$hadUnderscore)
1881         {
1882                 flushTable();
1883                 plainOutput("<TR></TR><TR></TR>\n");
1884         }
1885         elsif ($_ eq ".br" && $troffMultiline)
1886         {
1887                 $rowref->[$troffCol] .= "<BR>\n";
1888         }
1889         elsif ($_ !~ m/^\./)
1890         {
1891                 $rowref = $tableRows[$#tableRows];      # reference to current row (last row in array)
1892                 if ($troffCol==0 && @troffRowDefs)
1893                 {
1894                         $rowDef = shift @troffRowDefs;
1895                         if ($rowDef =~ m/^[_=]/)
1896                         {
1897                                 $xxx = $_;
1898                                 flushTable();
1899                                 plainOutput("<TR></TR><TR></TR>\n");
1900                                 $hadUnderscore = 1;
1901                                 $_ = $xxx;
1902                                 $rowDef = shift @troffRowDefs;
1903                         }
1904                         @troffColDefs = split(/\t/, $rowDef);
1905                 }
1906
1907                 if ($troffCol == 0 && !$troffMultiline)
1908                 {
1909                         $rowref = [];
1910                         push(@tableRows, $rowref);
1911                         #plainOutput("<TR valign=top>");
1912                 }
1913
1914                 #{
1915                 if (m/T}/)
1916                 {
1917                         $troffMultiline = 0;
1918                 }
1919                 if ($troffMultiline)
1920                 {
1921                         $rowref->[$troffCol] .= "$_\n";
1922                         return;
1923                 }
1924
1925                 @columns = split(/\t/, $_);
1926                 plainOutput("<!-- Adding (".join(",", @columns)."), type (".join(",", @troffColDefs).") -->\n") if ($debug);
1927                 while ($troffCol <= $#troffColDefs && @columns > 0)
1928                 {
1929                         $def = $troffColDefs[$troffCol];
1930                         $col = shift @columns;
1931                         $col =~ s/\s*$//;
1932                         $align = "";
1933                         $col = "\\^" if ($col eq "" && $def =~ m/\^/);
1934                         $col = "&nbsp;" if ($col eq "");
1935                         $style1 = "";
1936                         $style2 = "";
1937                         if ($col ne "\\^")
1938                         {
1939                                 if ($def =~ m/[bB]/ || $def =~ m/f3/)
1940                                         { $style1 = "\\fB"; $style2 = "\\fP"; }
1941                                 if ($def =~ m/I/ || $def =~ m/f2/)
1942                                         { $style1 = "\\fI"; $style2 = "\\fP"; }
1943                         }
1944                         if ($def =~ m/c/) { $align = " align=center"; }
1945                         if ($def =~ m/[rn]/) { $align = " align=right"; }
1946                         $span = $def;
1947                         $span =~ s/[^s]//g;
1948                         if ($span) { $align.= " colspan=".(length($span)+1); }
1949
1950                         #{
1951                         if ($col =~ m/T}/)
1952                         {
1953                                 $rowref->[$troffCol] .= "$style2</TD>";
1954                                 ++$troffCol;
1955                         }
1956                         elsif ($col =~ m/T{/) #}
1957                         {
1958                                 $col =~ s/T{//; #}
1959                                 $rowref->[$troffCol] = "<TD$align>$style1$col";
1960                                 $troffMultiline = 1;
1961                         }
1962                         else
1963                         {
1964                                 $rowref->[$troffCol] = "<TD$align>$style1$col$style2</TD>";
1965                                 ++$troffCol;
1966                         }
1967                 }
1968
1969                 endTblRow() unless ($troffMultiline);
1970         }
1971 }
1972
1973 sub endTblRow
1974 {
1975         return if ($troffCol == 0);
1976         while ($troffCol <= $#troffColDefs)
1977         {
1978                 $rowref->[$troffCol] = "<TD>&nbsp;</TD>";
1979                 #print OUT "<TD>&nbsp;</TD>";
1980                 ++$troffCol;
1981         }
1982         $troffCol = 0;
1983         #print OUT "</TR>\n"
1984 }
1985
1986 sub flushTable
1987 {
1988         plainOutput("<!-- flushTable $#tableRows rows -->\n") if ($debug);
1989
1990         # Treat rows with first cell blank or with more than one vertically
1991         # spanned row as a continuation of the previous line.
1992         # Note this is frequently a useful heuristic but isn't foolproof.
1993         for($r=0; $r<$#tableRows; ++$r)
1994         {
1995                 $vspans = 0;
1996                 for ($c=0; $c<=$#{$tableRows[$r+1]}; ++$c)
1997                         {++$vspans if ($tableRows[$r+1][$c] =~ m,<TD.*?>\\\^</TD>,);}
1998                 if ((($vspans>1) || ($tableRows[$r+1][0] =~ m,<TD.*?>&nbsp;</TD>,)) &&
1999                         $#{$tableRows[$r]} == $#{$tableRows[$r+1]}  && 0)
2000                 {
2001                         if ($debug)
2002                         {
2003                                 plainOutput("<!-- merging row $r+1 into previous -->\n");
2004                                 plainOutput("<!-- row $r: (".join(",", @{$tableRows[$r]}).") -->\n");
2005                                 plainOutput("<!-- row $r+1: (".join(",", @{$tableRows[$r+1]}).") -->\n");
2006                         }
2007                         for ($c=0; $c<=$#{$tableRows[$r]}; ++$c)
2008                         {
2009                                 $tableRows[$r][$c] .= $tableRows[$r+1][$c];
2010                                 $tableRows[$r][$c] =~ s,\\\^,,g;        # merging is stronger than spanning!
2011                                 $tableRows[$r][$c] =~ s,</TD><TD.*?>,<BR>,;
2012                         }
2013                         @tableRows = (@tableRows[0..$r], @tableRows[$r+2 .. $#tableRows]);
2014                         --$r;   # process again
2015                 }
2016         }
2017
2018         # Turn \^ vertical span requests into rowspan tags
2019         for($r=0; $r<$#tableRows; ++$r)
2020         {
2021                 for ($c=0; $c<=$#{$tableRows[$r]}; ++$c)
2022                 {
2023                         $r2 = $r+1;
2024                         while ( $r2<=$#tableRows && ($tableRows[$r2][$c] =~ m,<TD.*?>\\\^</TD>,) )
2025                         {
2026                                 ++$r2;
2027                         }
2028                         $rs = $r2-$r;
2029                         if ($rs > 1)
2030                         {
2031                                 plainOutput("<!-- spanning from $r,$c -->\n") if ($debug);
2032                                 $tableRows[$r][$c] =~ s/<TD/<TD rowspan=$rs/;
2033                         }
2034                 }
2035         }
2036
2037         # As tbl and html differ in whether they expect spanned cells to be
2038         # supplied, remove any cells that are 'rowspanned into'.
2039         for($r=0; $r<=$#tableRows; ++$r)
2040         {
2041                 for ($c=$#{$tableRows[$r]}; $c>=0; --$c)
2042                 {
2043                         if ($tableRows[$r][$c] =~ m/<TD rowspan=(\d+)/)
2044                         {
2045                                 for ($r2=$r+1; $r2<$r+$1; ++$r2)
2046                                 {
2047                                         $rowref = $tableRows[$r2];
2048                                         plainOutput("<!-- removing $r2,$c: ".$rowref->[$c]." -->\n") if ($debug);
2049                                         @$rowref = (@{$rowref}[0..$c-1], @{$rowref}[$c+1..$#$rowref]);
2050                                 }
2051                         }
2052                 }
2053         }
2054
2055         # Finally, output the cells that are left
2056         for($r=0; $r<=$#tableRows; ++$r)
2057         {
2058                 plainOutput("<TR valign=top>\n");
2059                 for ($c=0; $c <= $#{$tableRows[$r]}; ++$c)
2060                 {
2061                         outputLine($tableRows[$r][$c]);
2062                 }
2063                 plainOutput("</TR>\n");
2064         }
2065         @tableRows = ();
2066         $troffCol = 0;
2067         plainOutput("<!-- flushTable done -->\n") if ($debug);
2068 }
2069
2070
2071 # Use these for all font changes, including .ft, .ps, .B, .BI, .SM etc.
2072 # Need to add a mechanism to stack up these changes so tags match: <X> <Y> ... </Y> </X> etc.
2073
2074 sub pushStyle
2075 {
2076         $result = "";
2077         $type = $_[0];
2078         $tag = $_[1];
2079         print OUT "<!-- pushStyle $type($tag) [".join(",", @styleStack)."] " if ($debug>1);
2080         @oldItems = ();
2081         if (grep(m/^$type/, @styleStack))
2082         {
2083                 print OUT "undoing up to old $type " if ($debug>1);
2084                 while (@styleStack)
2085                 {
2086                         # search back, undoing intervening tags in reverse order
2087                         $oldItem = pop @styleStack;
2088                         ($oldTag) = ($oldItem =~ m/^.(\S+)/);
2089                         $result .= "</$oldTag>";
2090                         if (substr($oldItem,0,1) eq $type)
2091                         {
2092                                 print OUT "found $oldItem " if ($debug>1);
2093                                 while (@oldItems)
2094                                 {
2095                                         # restore the intermediates again
2096                                         $oldItem = shift @oldItems;
2097                                         push(@styleStack, $oldItem);
2098                                         $result .= "<".substr($oldItem,1).">";
2099                                 }
2100                                 last;
2101                         }
2102                         else
2103                         {
2104                                 unshift(@oldItems, $oldItem);
2105                         }
2106                 }
2107         }
2108         print OUT "oldItems=(@oldItems) " if ($debug>1);
2109         push(@styleStack, @oldItems);   # if we didn't find anything of type
2110         if ($tag)
2111         {
2112                 $result .= "<$tag>";
2113                 push(@styleStack, $type.$tag);
2114         }
2115         print OUT "-> '$result' -->\n" if ($debug>1);
2116         return $result;
2117 }
2118
2119 sub resetStyles
2120 {
2121         if (@styleStack)
2122         {
2123                 print OUT "<!-- resetStyles [".join(",", @styleStack)."] -->\n";
2124                 print OUT "<HR> resetStyles [".join(",", @styleStack)."] <HR>\n" if ($debug);
2125         }
2126         while (@styleStack)
2127         {
2128                 $oldItem = pop @styleStack;
2129                 ($oldTag) = ($oldItem =~ m/^.(\S+)/);
2130                 print OUT "</$oldTag>";
2131         }
2132         $currentSize = 0;
2133         $currentShift = 0;
2134 }
2135
2136 sub blockquote
2137 {
2138         print OUT "<BLOCKQUOTE>\n";
2139         ++$blockquote;
2140 }
2141
2142 sub endBlockquote
2143 {
2144         resetStyles();
2145         while ($blockquote > 0)
2146         {
2147                 print OUT "</BLOCKQUOTE>\n";
2148                 --$blockquote;
2149         }
2150 }
2151
2152 sub indent
2153 {
2154         plainOutput(pushStyle("I", "TABLE"));
2155         $width = $_[0];
2156         $width = " width=$width%" if ($width);
2157         plainOutput("<TR><TD$width>&nbsp;</TD><TD>\n");
2158 }
2159
2160 sub outdent
2161 {
2162         plainOutput("</TD></TR>\n");
2163         plainOutput(pushStyle("I"));
2164 }
2165
2166 sub inlineStyle
2167 {
2168         $_[0] =~ m/^(.)(.*)$/;
2169         if ($1 eq "f")
2170                 { fontChange($2); }
2171         elsif ($1 eq "s" && ! $noFill)
2172                 { sizeChange($2); }
2173         else
2174                 { superSub($1); }
2175 }
2176
2177 sub fontChange
2178 {
2179         $fnt = $_[0];
2180         $fnt =~ s/^\(//;
2181
2182         if ($fnt eq "P" || $fnt eq "R" || $fnt eq "1" || $fnt eq "")
2183                 { $font = ""; }
2184         elsif ($fnt eq "B" || $fnt eq "3")
2185                 { $font = "B"; }
2186         elsif ($fnt eq "I" || $fnt eq "2")
2187                 { $font = "I"; }
2188         else
2189                 { $font = "TT"; }
2190         return pushStyle("F", $font);
2191 }
2192
2193 sub sizeChange
2194 {
2195         $size= $_[0];
2196         if ($size =~ m/^[+-]/)
2197                 { $currentSize += $size; }
2198         else
2199                 { $currentSize = $size-10; }
2200         $currentSize = 0 if (! $size);
2201
2202         $sz = $currentSize;
2203         $sz = -2 if ($sz < -2);
2204         $sz = 2 if ($sz > 2);
2205
2206         if ($currentSize eq "0")
2207                 { $size = ""; }
2208         else
2209                 { $size = "FONT size=$sz"; }
2210         return pushStyle("S", $size);
2211 }
2212
2213 sub superSub
2214 {
2215         $sub = $_[0];
2216         ++$currentShift if ($sub eq "u");
2217         --$currentShift if ($sub eq "d");
2218         $tag = "";
2219         $tag = "SUP" if ($currentShift > 0);
2220         $tag = "SUB" if ($currentShift < 0);
2221         return pushStyle("D", $tag);
2222 }
2223
2224 sub startNoFill
2225 {
2226         print OUT "<PRE>\n" unless($noFill);
2227         $noFill = 1;
2228 }
2229
2230 sub endNoFill
2231 {
2232         print OUT "</PRE>\n" if ($noFill);
2233         $noFill = 0;
2234 }
2235
2236
2237 sub processEqns
2238 {
2239         if ($eqnMode==2 && $_[0] =~ m/^\.EN/)
2240         {
2241                 $eqnMode = 0;
2242                 outputLine(flushEqn());
2243                 plainOutput("\n");
2244                 return;
2245         }
2246         $eqnBuffer .= $_[0]." ";
2247 }
2248
2249 sub processEqnd
2250 {
2251         processEqns(@_);
2252         return flushEqn();
2253 }
2254
2255 sub flushEqn
2256 {
2257         @p = grep($_ !~ m/^ *$/, split(/("[^"]*"|\s+|[{}~^])/, $eqnBuffer) );
2258         $eqnBuffer = "";
2259         #return "[".join(',', @p)." -> ".&doEqn(@p)."]\n";
2260         $res = &doEqn(@p);
2261         #$res =~ s,\\\((..),$special{$1}||"\\($1",ge;
2262         #$res =~ s,<,&lt;,g;
2263         #$res =~ s,>,&gt;,g;
2264         return $res;
2265 }
2266
2267 sub doEqn
2268 {
2269         my @p = @_;
2270         my $result = "";
2271         my $res;
2272         my $c;
2273         while (@p)
2274         {
2275                 ($res, @p) = doEqn1(@p);
2276                 $result .= $res;
2277         }
2278         return $result;
2279 }
2280
2281 sub doEqn1
2282 {
2283         my @p = @_;
2284         my $res = "";
2285         my $c;
2286
2287         $c = shift @p;
2288         if ($eqndefs{$c})
2289         {
2290                 @x = split(/\0/, $eqndefs{$c});
2291                 unshift @p, @x;
2292                 $c = shift @p;
2293         }
2294         if ($c =~ m/^"(.*)"$/)
2295         {
2296                 $res = $1;
2297         }
2298         elsif ($c eq "delim")
2299         {
2300                 $c = shift @p;
2301                 if ($c eq "off")
2302                 {
2303                         $eqnStart = "";
2304                         $eqnEnd = "";
2305                 }
2306                 else
2307                 {
2308                         $c =~ m/^(.)(.)/;
2309                         $eqnStart = quotemeta($1);
2310                         $eqnEnd = quotemeta($2);
2311                 }
2312         }
2313         elsif ($c eq "define" || $c eq "tdefine" || $c eq "ndefine")
2314         {
2315                 $t = shift @p;
2316                 $d = shift @p;
2317                 $def = "";
2318                 if (length($d) != 1)
2319                 {
2320                         $def = $d;
2321                         $def =~ s/^.(.*)./\1/;
2322                 }
2323                 else
2324                 {
2325                         while (@p && $p[0] ne $d)
2326                         {
2327                                 $def .= shift @p;
2328                                 $def .= "\0";
2329                         }
2330                         chop $def;
2331                         shift @p;
2332                 }
2333                 $eqndefs{$t} = $def unless ($c eq "ndefine");
2334         }
2335         elsif ($c eq "{")
2336         {
2337                 my $level = 1;
2338                 my $i;
2339                 for ($i=0; $i<=$#p; ++$i)
2340                 {
2341                         ++$level if ($p[$i] eq "{");
2342                         --$level if ($p[$i] eq "}");
2343                         last if ($level==0);
2344                 }
2345                 $res = doEqn(@p[0..$i-1]);
2346                 @p = @p[$i+1..$#p];
2347         }
2348         elsif ($c eq "sup")
2349         {
2350                 ($c,@p) = &doEqn1(@p);
2351                 $res = "\\u$c\\d";
2352         }
2353         elsif ($c eq "to")
2354         {
2355                 ($c,@p) = &doEqn1(@p);
2356                 $res = "\\u$c\\d ";
2357         }
2358         elsif ($c eq "sub" || $c eq "from")
2359         {
2360                 ($c,@p) = &doEqn1(@p);
2361                 $res = "\\d$c\\u";
2362         }
2363         elsif ($c eq "matrix")
2364         {
2365                 ($c,@p) = &doEqn1(@p);
2366                 $res = "matrix ( $c )";
2367         }
2368         elsif ($c eq "bold")
2369         {
2370                 ($c,@p) = &doEqn1(@p);
2371                 $res = "\\fB$c\\fP";
2372         }
2373         elsif ($c eq "italic")
2374         {
2375                 ($c,@p) = &doEqn1(@p);
2376                 $res = "\\fI$c\\fP";
2377         }
2378         elsif ($c eq "roman")
2379         {
2380         }
2381         elsif ($c eq "font" || $c eq "gfont" || $c eq "size" || $c eq "gsize")
2382         {
2383                 shift @p;
2384         }
2385         elsif ($c eq "mark" || $c eq "lineup")
2386         {
2387         }
2388         elsif ($c eq "~" || $c eq "^")
2389         {
2390                 $res = " ";
2391         }
2392         elsif ($c eq "over")
2393         {
2394                 $res = " / ";
2395         }
2396         elsif ($c eq "half")
2397         {
2398                 $res = "\\(12";
2399         }
2400         elsif ($c eq "prime")
2401         {
2402                 $res = "\\' ";
2403         }
2404         elsif ($c eq "dot")
2405         {
2406                 $res = "\\u.\\d ";
2407         }
2408         elsif ($c eq "dotdot")
2409         {
2410                 $res = "\\u..\\d ";
2411         }
2412         elsif ($c eq "tilde")
2413         {
2414                 $res = "\\u~\\d ";
2415         }
2416         elsif ($c eq "hat")
2417         {
2418                 $res = "\\u^\\d ";
2419         }
2420         elsif ($c eq "bar" || $c eq "vec")
2421         {
2422                 $res = "\\(rn ";
2423         }
2424         elsif ($c eq "under")
2425         {
2426                 $res = "_ ";
2427         }
2428         elsif ( $c eq "sqrt" || $c eq "lim" || $c eq "sum" || $c eq "pile" || $c eq "lpile" ||
2429                         $c eq "rpile" || $c eq "cpile" || $c eq "int" || $c eq "prod" )
2430         {
2431                 $res = " $c ";
2432         }
2433         elsif ($c eq "cdot")
2434         {
2435                 $res = " . ";
2436         }
2437         elsif ($c eq "inf")
2438         {
2439                 $res = "\\(if";
2440         }
2441         elsif ($c eq "above" || $c eq "lcol" || $c eq "ccol")
2442         {
2443                 $res = " ";
2444         }
2445         elsif ($c eq "sin" || $c eq "cos" || $c eq "tan" || $c eq "log" || $c eq "ln" )
2446         {
2447                 $res = " $c ";
2448         }
2449         elsif ($c eq "left" || $c eq "right" || $c eq "nothing")
2450         {
2451         }
2452         elsif ($c =~ m/^[A-Za-z]/)
2453         {
2454                 $res = "\\fI$c\\fP";
2455         }
2456         else
2457         {
2458                 $res = $c;
2459         }
2460
2461         return ($res, @p);
2462 }
2463
2464 ##### Search manpath and initialise special char array #####
2465
2466 sub initialise
2467 {
2468         # Determine groff version if possible
2469         my $groffver = `groff -v`;
2470         $groffver =~ /^GNU groff version (\S+)/;
2471         $groffver = $1;
2472
2473         # Parse the macro definition file for section names
2474         if (open(MACRO, "/usr/lib/tmac/tmac.an") ||
2475                 open(MACRO, "/usr/lib/tmac/an") ||
2476                 open(MACRO, "/usr/lib/groff/tmac/tmac.an") ||
2477                 open(MACRO, "/usr/lib/groff/tmac/an.tmac") ||
2478                 open(MACRO, "/usr/share/tmac/tmac.an") ||
2479                 open(MACRO, "/usr/share/tmac/an.tmac") ||
2480                 open(MACRO, "/usr/share/groff/tmac/tmac.an") ||
2481                 open(MACRO, "/usr/share/groff/tmac/an.tmac") ||
2482                 open(MACRO, "/usr/share/groff/$groffver/tmac/an.tmac") )
2483         {
2484                 while (<MACRO>)
2485                 {
2486                         chop;
2487                         if (m/\$2'([0-9a-zA-Z]+)' .ds ]D (.*)$/)
2488                         {
2489                                 $sn = $2;
2490                                 unless ($sn =~ m/[a-z]/)
2491                                 {
2492                                         $sn = "\u\L$sn";
2493                                         $sn =~ s/ (.)/ \u\1/g;
2494                                 }
2495                                 $sectionName{"\L$1"} = $sn;
2496                         }
2497                         if (m/\$1'([^']+)' .ds Tx "?(.*)$/)
2498                         {
2499                                 $title{"$1"} = $2;
2500                         }
2501                         if (m/^.ds ]W (.*)$/)
2502                         {
2503                                 $osver = $1;
2504                         }
2505                 }
2506         }
2507         else
2508         {
2509                 print STDERR "Failed to read tmac.an definitions\n" unless ($cgiMode);
2510         }
2511         if (open(MACRO, "/usr/lib/tmac/tz.map"))
2512         {
2513                 while (<MACRO>)
2514                 {
2515                         chop;
2516                         if (m/\$1'([^']+)' .ds Tz "?(.*)$/)
2517                         {
2518                                 $title{"$1"} = $2;
2519                         }
2520                 }
2521         }
2522
2523         # Prevent redefinition of macros that have special meaning to us
2524         $reservedMacros = '^(SH|SS|Sh|Ss)$';
2525
2526         # Predefine special number registers
2527         $number{'.l'} = 75;
2528
2529         # String variables defined by man package
2530         $vars{'lq'} = '&#147;';
2531         $vars{'rq'} = '&#148;';
2532         $vars{'R'} = '\\(rg';
2533         $vars{'S'} = '\\s0';
2534
2535         # String variables defined by mdoc package
2536         $vars{'Le'} = '\\(<=';
2537         $vars{'<='} = '\\(<=';
2538         $vars{'Ge'} = '\\(>=';
2539         $vars{'Lt'} = '<';
2540         $vars{'Gt'} = '>';
2541         $vars{'Ne'} = '\\(!=';
2542         $vars{'>='} = '\\(>=';
2543         $vars{'q'} = '&#34;';   # see also special case in preProcessLine
2544         $vars{'Lq'} = '&#147;';
2545         $vars{'Rq'} = '&#148;';
2546         $vars{'ua'} = '\\(ua';
2547         $vars{'ga'} = '\\(ga';
2548         $vars{'Pi'} = '\\(*p';
2549         $vars{'Pm'} = '\\(+-';
2550         $vars{'Na'} = 'NaN';
2551         $vars{'If'} = '\\(if';
2552         $vars{'Ba'} = '|';
2553
2554         # String variables defined by ms package (access to accented characters)
2555         $vars{'bu'} = '&#187;';
2556         $vars{'66'} = '&#147;';
2557         $vars{'99'} = '&#148;';
2558         $vars{'*!'} = '&#161;';
2559         $vars{'ct'} = '&#162;';
2560         $vars{'po'} = '&#163;';
2561         $vars{'gc'} = '&#164;';
2562         $vars{'ye'} = '&#165;';
2563         #$vars{'??'} = '&#166;';
2564         $vars{'sc'} = '&#167;';
2565         $vars{'*:'} = '&#168;';
2566         $vars{'co'} = '&#169;';
2567         $vars{'_a'} = '&#170;';
2568         $vars{'<<'} = '&#171;';
2569         $vars{'no'} = '&#172;';
2570         $vars{'hy'} = '&#173;';
2571         $vars{'rg'} = '&#174;';
2572         $vars{'ba'} = '&#175;';
2573         $vars{'de'} = '&#176;';
2574         $vars{'pm'} = '&#177;';
2575         #$vars{'??'} = '&#178;';
2576         #$vars{'??'} = '&#179;';
2577         $vars{'aa'} = '&#180;';
2578         $vars{'mu'} = '&#181;';
2579         $vars{'pg'} = '&#182;';
2580         $vars{'c.'} = '&#183;';
2581         $vars{'cd'} = '&#184;';
2582         #$vars{'??'} = '&#185;';
2583         $vars{'_o'} = '&#186;';
2584         $vars{'>>'} = '&#187;';
2585         $vars{'14'} = '&#188;';
2586         $vars{'12'} = '&#189;';
2587         #$vars{'??'} = '&#190;';
2588         $vars{'*?'} = '&#191;';
2589         $vars{'`A'} = '&#192;';
2590         $vars{"'A"} = '&#193;';
2591         $vars{'^A'} = '&#194;';
2592         $vars{'~A'} = '&#195;';
2593         $vars{':A'} = '&#196;';
2594         $vars{'oA'} = '&#197;';
2595         $vars{'AE'} = '&#198;';
2596         $vars{',C'} = '&#199;';
2597         $vars{'`E'} = '&#200;';
2598         $vars{"'E"} = '&#201;';
2599         $vars{'^E'} = '&#202;';
2600         $vars{':E'} = '&#203;';
2601         $vars{'`I'} = '&#204;';
2602         $vars{"'I"} = '&#205;';
2603         $vars{'^I'} = '&#206;';
2604         $vars{':I'} = '&#207;';
2605         $vars{'-D'} = '&#208;';
2606         $vars{'~N'} = '&#209;';
2607         $vars{'`O'} = '&#210;';
2608         $vars{"'O"} = '&#211;';
2609         $vars{'^O'} = '&#212;';
2610         $vars{'~O'} = '&#213;';
2611         $vars{':O'} = '&#214;';
2612         #$vars{'mu'} = '&#215;';
2613         $vars{'NU'} = '&#216;';
2614         $vars{'`U'} = '&#217;';
2615         $vars{"'U"} = '&#218;';
2616         $vars{'^U'} = '&#219;';
2617         $vars{':U'} = '&#220;';
2618         #$vars{'??'} = '&#221;';
2619         $vars{'Th'} = '&#222;';
2620         $vars{'*b'} = '&#223;';
2621         $vars{'`a'} = '&#224;';
2622         $vars{"'a"} = '&#225;';
2623         $vars{'^a'} = '&#226;';
2624         $vars{'~a'} = '&#227;';
2625         $vars{':a'} = '&#228;';
2626         $vars{'oa'} = '&#229;';
2627         $vars{'ae'} = '&#230;';
2628         $vars{',c'} = '&#231;';
2629         $vars{'`e'} = '&#232;';
2630         $vars{"'e"} = '&#233;';
2631         $vars{'^e'} = '&#234;';
2632         $vars{':e'} = '&#235;';
2633         $vars{'`i'} = '&#236;';
2634         $vars{"'i"} = '&#237;';
2635         $vars{'^i'} = '&#238;';
2636         $vars{':i'} = '&#239;';
2637         #$vars{'??'} = '&#240;';
2638         $vars{'~n'} = '&#241;';
2639         $vars{'`o'} = '&#242;';
2640         $vars{"'o"} = '&#243;';
2641         $vars{'^o'} = '&#244;';
2642         $vars{'~o'} = '&#245;';
2643         $vars{':o'} = '&#246;';
2644         $vars{'di'} = '&#247;';
2645         $vars{'nu'} = '&#248;';
2646         $vars{'`u'} = '&#249;';
2647         $vars{"'u"} = '&#250;';
2648         $vars{'^u'} = '&#251;';
2649         $vars{':u'} = '&#252;';
2650         #$vars{'??'} = '&#253;';
2651         $vars{'th'} = '&#254;';
2652         $vars{':y'} = '&#255;';
2653
2654         # troff special characters and their closest equivalent
2655
2656         $special{'em'} = '&#151;';
2657         $special{'hy'} = '-';
2658         $special{'\-'} = '&#150;';      # was -
2659         $special{'bu'} = 'o';
2660         $special{'sq'} = '[]';
2661         $special{'ru'} = '_';
2662         $special{'14'} = '&#188;';
2663         $special{'12'} = '&#189;';
2664         $special{'34'} = '&#190;';
2665         $special{'fi'} = 'fi';
2666         $special{'fl'} = 'fl';
2667         $special{'ff'} = 'ff';
2668         $special{'Fi'} = 'ffi';
2669         $special{'Fl'} = 'ffl';
2670         $special{'de'} = '&#176;';
2671         $special{'dg'} = '&#134;';      # was 182, para symbol
2672         $special{'fm'} = "\\'";
2673         $special{'ct'} = '&#162;';
2674         $special{'rg'} = '&#174;';
2675         $special{'co'} = '&#169;';
2676         $special{'pl'} = '+';
2677         $special{'mi'} = '-';
2678         $special{'eq'} = '=';
2679         $special{'**'} = '*';
2680         $special{'sc'} = '&#167;';
2681         $special{'aa'} = '&#180;';      # was '
2682         $special{'ga'} = '&#96;';       # was `
2683         $special{'ul'} = '_';
2684         $special{'sl'} = '/';
2685         $special{'*a'} = 'a';
2686         $special{'*b'} = '&#223;';
2687         $special{'*g'} = 'y';
2688         $special{'*d'} = 'd';
2689         $special{'*e'} = 'e';
2690         $special{'*z'} = 'z';
2691         $special{'*y'} = 'n';
2692         $special{'*h'} = 'th';
2693         $special{'*i'} = 'i';
2694         $special{'*k'} = 'k';
2695         $special{'*l'} = 'l';
2696         $special{'*m'} = '&#181;';
2697         $special{'*n'} = 'v';
2698         $special{'*c'} = '3';
2699         $special{'*o'} = 'o';
2700         $special{'*p'} = 'pi';
2701         $special{'*r'} = 'p';
2702         $special{'*s'} = 's';
2703         $special{'*t'} = 't';
2704         $special{'*u'} = 'u';
2705         $special{'*f'} = 'ph';
2706         $special{'*x'} = 'x';
2707         $special{'*q'} = 'ps';
2708         $special{'*w'} = 'o';
2709         $special{'*A'} = 'A';
2710         $special{'*B'} = 'B';
2711         $special{'*G'} = '|\\u_\\d';
2712         $special{'*D'} = '/&#92;';
2713         $special{'*E'} = 'E';
2714         $special{'*Z'} = 'Z';
2715         $special{'*Y'} = 'H';
2716         $special{'*H'} = 'TH';
2717         $special{'*I'} = 'I';
2718         $special{'*K'} = 'K';
2719         $special{'*L'} = 'L';
2720         $special{'*M'} = 'M';
2721         $special{'*N'} = 'N';
2722         $special{'*C'} = 'Z';
2723         $special{'*O'} = 'O';
2724         $special{'*P'} = '||';
2725         $special{'*R'} = 'P';
2726         $special{'*S'} = 'S';
2727         $special{'*T'} = 'T';
2728         $special{'*U'} = 'Y';
2729         $special{'*F'} = 'PH';
2730         $special{'*X'} = 'X';
2731         $special{'*Q'} = 'PS';
2732         $special{'*W'} = 'O';
2733         $special{'ts'} = 's';
2734         $special{'sr'} = 'v/';
2735         $special{'rn'} = '\\u&#150;\\d';        # was 175
2736         $special{'>='} = '&gt;=';
2737         $special{'<='} = '&lt;=';
2738         $special{'=='} = '==';
2739         $special{'~='} = '~=';
2740         $special{'ap'} = '&#126;';      # was ~
2741         $special{'!='} = '!=';
2742         $special{'->'} = '-&gt;';
2743         $special{'<-'} = '&lt;-';
2744         $special{'ua'} = '^';
2745         $special{'da'} = 'v';
2746         $special{'mu'} = '&#215;';
2747         $special{'di'} = '&#247;';
2748         $special{'+-'} = '&#177;';
2749         $special{'cu'} = 'U';
2750         $special{'ca'} = '^';
2751         $special{'sb'} = '(';
2752         $special{'sp'} = ')';
2753         $special{'ib'} = '(=';
2754         $special{'ip'} = '=)';
2755         $special{'if'} = 'oo';
2756         $special{'pd'} = '6';
2757         $special{'gr'} = 'V';
2758         $special{'no'} = '&#172;';
2759         $special{'is'} = 'I';
2760         $special{'pt'} = '~';
2761         $special{'es'} = '&#216;';
2762         $special{'mo'} = 'e';
2763         $special{'br'} = '|';
2764         $special{'dd'} = '&#135;';      # was 165, yen
2765         $special{'rh'} = '=&gt;';
2766         $special{'lh'} = '&lt;=';
2767         $special{'or'} = '|';
2768         $special{'ci'} = 'O';
2769         $special{'lt'} = '(';
2770         $special{'lb'} = '(';
2771         $special{'rt'} = ')';
2772         $special{'rb'} = ')';
2773         $special{'lk'} = '|';
2774         $special{'rk'} = '|';
2775         $special{'bv'} = '|';
2776         $special{'lf'} = '|';
2777         $special{'rf'} = '|';
2778         $special{'lc'} = '|';
2779         $special{'rc'} = '|';
2780
2781         # Not true troff characters but very common typos
2782         $special{'cp'} = '&#169;';
2783         $special{'tm'} = '&#174;';
2784         $special{'en'} = '-';
2785
2786         # Build a list of directories containing man pages
2787         @manpath = ();
2788         if (open(MPC, "/etc/manpath.config") || open(MPC, "/etc/man.config"))
2789         {
2790                 while (<MPC>)
2791                 {
2792                         if (m/^(MANDB_MAP|MANPATH)\s+(\S+)/)
2793                         {
2794                                 push(@manpath, $2);
2795                         }
2796                 }
2797         }
2798         @manpath = split(/:/, $ENV{'MANPATH'}) unless (@manpath);
2799         @manpath = ("/usr/man") unless (@manpath);
2800 }
2801
2802 # Search through @manpath and construct @mandirs (non-empty subsections)
2803 sub loadManDirs
2804 {
2805         return if (@mandirs);
2806         print STDERR "Searching ",join(":", @manpath)," for mandirs\n" unless($cgiMode);
2807         foreach $tld (@manpath)
2808         {
2809                 $tld =~ m/^(.*)$/;
2810                 $tld = $1;      # untaint manpath
2811                 if (opendir(DIR, $tld))
2812                 {
2813                         # foreach $d (<$tld/man[0-9a-z]*>)
2814                         foreach $d (sort readdir(DIR))
2815                         {
2816                                 if ($d =~ m/^man\w/ && -d "$tld/$d")
2817                                 {
2818                                         push (@mandirs, "$tld/$d");
2819                                 }
2820                         }
2821                         closedir DIR;
2822                 }
2823         }
2824 }
2825
2826 ##### Utility to search manpath for a given command #####
2827
2828 sub findPage
2829 {
2830         $request = $_[0];
2831         $request =~ s,^/,,;
2832         @multipleMatches = ();
2833
2834         $file = $_[0];
2835         return $file if (-f $file || -f "$file.gz" || -f "$file.bz2");
2836
2837         # Search the path for the requested man page, which may be of the form:
2838         # "/usr/man/man1/ls.1", "ls.1" or "ls".
2839         ($page,$sect) = ($request =~ m/^(.+)\.([^.]+)$/);
2840         $sect = "\L$sect";
2841
2842         # Search the specified section first (if specified)
2843         if ($sect)
2844         {
2845                 foreach $md (@manpath)
2846                 {
2847                         $dir = $md;
2848                         $file = "$dir/man$sect/$page.$sect";
2849                         push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2");
2850                 }
2851         }
2852         else
2853         {
2854                 $page = $request;
2855         }
2856         if (@multipleMatches == 1)
2857         {
2858                 return pop @multipleMatches;
2859         }
2860
2861         # If not found need to search through each directory
2862         loadManDirs();
2863         foreach $dir (@mandirs)
2864         {
2865                 ($s) = ($dir =~ m/man([0-9A-Za-z]+)$/);
2866                 $file = "$dir/$page.$s";
2867                 push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2");
2868                 $file = "$dir/$request";
2869                 push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2");
2870                 if ($sect && "$page.$sect" ne $request)
2871                 {
2872                         $file = "$dir/$page.$sect";
2873                         push(@multipleMatches, $file) if (-f $file || -f "$file.gz" || -f "$file.bz2");
2874                 }
2875         }
2876         if (@multipleMatches == 1)
2877         {
2878                 return pop @multipleMatches;
2879         }
2880         if (@multipleMatches > 1)
2881         {
2882                 return "";
2883         }
2884         # Ok, didn't find it using section numbers. Perhaps there's a page with the
2885         # right name but wrong section number lurking there somewhere. (This search is slow)
2886         # eg. page.1x in man1 (not man1x) directory
2887         foreach $dir (@mandirs)
2888         {
2889                 opendir(DIR, $dir);
2890                 foreach $f (readdir DIR)
2891                 {
2892                         if ($f =~ m/^$page\./)
2893                         {
2894                                 $f =~ s/\.(gz|bz2)$//;
2895                                 push(@multipleMatches, "$dir/$f");
2896                         }
2897                 }
2898         }
2899         if (@multipleMatches == 1)
2900         {
2901                 return pop @multipleMatches;
2902         }
2903         return "";
2904 }
2905
2906 sub loadPerlPages
2907 {
2908         my ($dir,$f,$name,@files);
2909         loadManDirs();
2910         return if (%perlPages);
2911         foreach $dir (@mandirs)
2912         {
2913                 if (opendir(DIR, $dir))
2914                 {
2915                         @files = sort readdir DIR;
2916                         foreach $f (@files)
2917                         {
2918                                 next if ($f eq "." || $f eq ".." || $f !~ m/\./);
2919                                 next unless ("$dir/$f" =~ m/perl/);
2920                                 $f =~ s/\.(gz|bz2)$//;
2921                                 ($name) = ($f =~ m,(.+)\.[^.]*$,);
2922                                 $perlPages{$name} = "$dir/$f";
2923                         }
2924                         closedir DIR;
2925                 }
2926         }
2927         delete $perlPages{'perl'};      # too ubiquitous to be useful
2928 }
2929
2930 sub fmtTime
2931 {
2932     my $time = $_[0];
2933     my @days = qw (Sun Mon Tue Wed Thu Fri Sat);
2934     my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2935     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$istdst) = localtime($time);
2936     return sprintf ("%s, %02d %s %4d %02d:%02d:%02d GMT",
2937          $days[$wday],$mday,$months[$mon],1900+$year,$hour,$min,$sec);
2938 }
2939