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