InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/perl/scripts-convex/man.shar/man/catman

Text File | 1991-03-04 | 4.9 KB | 231 lines

#!/usr/local/bin/perl
#
# perl rewrite of catman
# author: tom christiansen <[e-mail]>
#
# Copyright 1990 Convex Computer Corporation.
# All rights reserved.

$| = 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;
}