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