#!/usr/local/bin/perl
#
# perl rewrite of catman 
# author: tom christiansen <tchrist@perl.com>
# Written in 1990

$| = 1;

$TBL	    = "tbl -D";
$EQN	    = "neqn";
# $MAKEWHATIS = "/usr/lib/makewhatis";
$MAKEWHATIS = "/usr/local/lib/makewhatis";
$COMPRESS   = "compress";
$NROFF	    = "nroff";
$COL 	    = "col";
$CAT	    = "cat";
$ZCAT	    = "zcat";

# Command to format man pages to be viewed on a tty or printed on a line printer
$CATSET	  = "$NROFF -h -man -";
$CATSET  .= " | $COL" if $COL;

umask 022;

do 'getopts.pl' || die("can't do getopts.pl", $@?$@:$!, "\n");

# -Z flag is planning for the future
unless (&Getopts('dpnwZP:M:') && $ARGV <= 1) {
    die "usage: $0 [-pnwZ] [[-M] manpath] [sections]\n";
}

$debug      =  $opt_d;
$makewhatis = !$opt_n;
$catman     = !$opt_w;
$fakeout    =  $opt_p;
$compress   =  $opt_Z;


$manpath = shift if $ARGV[0] =~ m#^/#;

if ($sections = shift) {
     $delim = ($sections =~ /:/) ? ':' : '';
     $sections =~ s/(.)-(.)/join("","$1".."$2")/ge; # expand 1-3 and l-p ranges
     grep($sections{$_}++, split(/$delim/,$sections));
     print STDERR "sections are: ", 
	 join(':',keys %sections), "\n" if $debug;
}


$manpath = $manpath || $opt_P || $opt_M || "/usr/man";


path: foreach $path (split(/:/,$manpath)) {
    unless (chdir $path) {
	warn "can't chdir to $path: $!";
	$status = 1;
	next path;
    }
    if ($makewhatis) {
	&run ("$MAKEWHATIS " . ($debug ? "-d" : "") . " $path") ||
		warn "$0: $MAKEWHATIS returned " . ($? >> 8) . " ($!)\n";
    }
    next unless $catman;

    print "chdir $path\n" if $debug;

    unless (dbmopen(%whatis, "whatis", undef)) {
	warn "can't dbmopen $path/whatis: $!\n";
	warn "$0: please run makewhatis first\n";
	$status++;
	next;
    } 

    $SIG{'PIPE'} = 'PLUMBER';

    while (($key,$value) = each %whatis) {

manpage: for (split(/\002/, $value)) {
	    next unless /\001/; # otherwise indirect reference

	    ($cmd, $page, $section, $desc) = split(/\001/);
	    $manpage = "$path/man$section/$page";
	    next if $sections && !$sections{$section};
	    print STDERR "considering $manpage\n" if $debug;

	    local(@st_man, @st_cat);

	    if ($manpage !~ /\S\.\S/) {
		print "skipping non man file: $manpage\n" if $debug;
		next manpage;
	    } 

	    if (!-e $manpage) {
		$manpage .= '.Z';
		next unless -e $manpage;
	    } 

	    ($catpage = $manpage) 
		=~ s,^(.*)/man([^\.]*)(\.Z)?/([^/]*)$,$1/cat$2$3/$4,;

	    ($catdir = $catpage) =~ s#/[^/]*$##;
	    next manpage unless -d $catdir && -w _;

	    if ((stat(_))[9] > (stat($catpage))[9]) {
		$command = (($manpage =~ m:\.Z:) ? $ZCAT : $CAT)
			    . " < $manpage | $CATSET";

		$command = &insert_filters($command, $manpage);
		$command =~ s,-man,$path/tmac.an, if -e "$path/tmac.an";

		$command .= "| $COMPRESS " if $catpage =~ /\.Z/;

		$command .= "> $catpage";

		eval '&reformat($command)'; # setjmp for SIGPIPE

		if ($@) {
		    next if $@ =~ /broken pipe/i;
		    die $@;
		}
	    }
	}
    } 
    dbmclose(whatis);
}

exit $status;

sub PLUMBER { die "Broken pipe writing to kid proc!\n"; }  # longjmp

sub insert_filters {
    local($filters,$eqn, $tbl, $_);
    local(*PAGE);
    local($command, $PAGE) = @_;


    $PAGE = "$ZCAT < $PAGE|" if $PAGE =~ /\.Z/;

    (open PAGE) || die ("can't open $page to check filters: $!\n");

    while (<PAGE>) {
	if (/^\.EQ/) {
	    $_ = <PAGE>;
	    $eqn = 1 unless /\.(if|nr)/;  # has eqn output not input
	} 
	if (/^\.TS/) {
	    $_ = <PAGE>;
	    $tbl = 1 unless /\.(if|nr)/;  # has tbl output not input
	} 
	last if $eqn && $tbl;
    } 
    close PAGE;

    $eqn && $_[0] =~ s/(\S+roff)/$EQN | $1/;
    $tbl && $_[0] =~ s/(\S+roff)/$TBL | $1/;

    $_[0];
} 


sub run {
    local($command) = $_[0];
    $command =~ s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
    $command =~ s/^([^|<]+)<([^Z|<]+)$/$1 $2/;
    print STDERR "$command\n" if $debug || $fakeout;
    if ((!$fakeout) && system($command)) {
	$status++;
	printf STDERR "\"%s\" exited %d, sig %d: $!\n", $command, 
	    ($? >> 8), ($? & 255) if $debug;
    } 
    $? == 0;
}

sub print {
    local($_) = @_;

    if (!$inbold) {
	print;
    } else {
	for (split(//)) {
	    print /[!-~]/ ? $_."\b".$_ : $_;
	} 
    } 
}

sub reformat {
    local($_) = @_;
    local($nroff, $col);
    local($inbold) = 0;

    s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
    s/^([^|<]+)<([^Z|<]+)$/$1 $2/;
    ($nroff, $col) = m!(.*)\|\s*($COL.*)!;

    print STDERR "$nroff | (this proc) | $col\n" if $debug || $fakeout;

    return 0 if $fakeout;

    open (NROFF, "$nroff |");
    open (COL, "| $col");

    select(COL);

    while (<NROFF>) {
	s/\033\+/\001/;
	s/\033\,/\002/;
	if ( /^([^\001]*)\002/ || /^([^\002]*)\001/ )  {
	    &print($1);
	    $inbold = !$inbold;
	    $_ = $';
	    redo;
	}   
	&print($_);
    }

    close NROFF;
    if ($?) {
	warn "$program: \"$nroff\" failed!\n";
	$status++;
    } 
    close COL;
    if ($?) {
	warn "$program: \"$col\" failed!\n";
	$status++;
    }
    select(STDOUT);
    1;
}
