The Answer to All Man's Problems (part 5 of 6)
Tom Christiansen
tchrist at convex.COM
Tue Jan 8 09:23:38 AEST 1991
X# ${MANALT}/${machine}/man(.+)/*.\11*
X$MANALT = $ENV{'MANALT'} || '/usr/local/man';
X
X# default program for -t command
X$TROFF = $ENV{'TROFF'} || 'nitroff';
X
X$NROFF = 'nroff';
X$NROFF_CAN_BOLD = 0; # if nroff puts out bold as H\bH
X
X# this are used if filters are needed
X$TBL = 'tbl';
X$NTBL = "$TBL -D"; # maybe you need -TX instead
X$NEQN = 'neqn';
X$EQN = 'eqn';
X$SED = 'sed';
X
X# define this if you don't have/want UL;
X# without ul, you probably need COL defined unless your PAGER is very smart
X# you also must use col instead of ul if you've any tbl'd man pages, such
X# as from the X man pages or the eqnchar.7 page.
X$COL = 'col';
X$UL = ''; # set to '' if you haven't got ul
Xdie 'need either $UL or $COL' unless $UL || $COL;
X
X# need these for .Z files or dirs
X$COMPRESS = 'compress';
X$ZCAT = 'zcat';
X$CAT = 'cat';
X
X# define COMPRESS_DIR if pages might have moved to manX.Z/page.X (like HPs)
X$COMPRESS_DIR = 1;
X# define COMPRESS_PAGE if pages might have moved to manX/page.X.Z (better)
X$COMPRESS_PAGE = 1;
X
X# Command to format man pages to be viewed on a tty or printed on a line printer
X$CATSET = "$NROFF -h -man -";
X
X$CATSET .= " | $COL" if $COL;
X
X# Command to typeset a man page
X$TYPESET = "$TROFF -man";
X
X
X# flags: GNU likes -i, BSD doesn't; both like -h, but BSD doesn't document it
X# if you don't put -i here, i'll make up for it later the hard way
X$EGREP = '/usr/local/bin/egrep';
Xif (-x $EGREP) {
X $EGREP .= ' -i -h';
X} else {
X $EGREP = '/usr/bin/egrep';
X unless (-x $EGREP) {
X $EGREP = '';
X } else {
X $EGREP .= ' -h';
X }
X}
X
X# sections that have verbose aliases
X# if you change this, change the usage message
X#
X# if you put any of these in their own trees, comment them out and make
X# a link in $MANALT so people can still say 'man local foo'; for local,
X# cd $MANALT; ln -s . local
X# for the other trees (new, old, public) put either them or links
X# to them in $MANALT
X#
X%SECTIONS = (
X 'local', 'l',
X 'new', 'n',
X 'old', 'o',
X 'public', 'p' );
X
X# turn this on if you want linked (via ".so" or otherwise) man pages
X# to be found even if the thing they are linked to doesn't know it's
X# being linked to -- that is, its NAME section doesn't have reference
X# to it. eg, if you call a man page 'gnugrep' but it's own NAME section
X# just calls it grep, then you need this. usually a good idea.
X#
X$STUPID_SO = 1;
X
X# --------------------------------------------------------------------------
X# end configuration section
X# --------------------------------------------------------------------------
X
X# CONVEX RCS keeps CHeader; others may prefer Header
X($bogus, $version) = split(/:\s*/,'$CHeader: man 0.40 91/01/07 15:40:15 $',2);
Xchop($version); chop($version);
X
Xrequire 'getopts.pl';
X
X# could do this via ioctl(0,$TIOCGETP,$sgtty) if I were really concerned
X#
X$rows = ($ENV{'TERMCAP'} =~ /:li#(\d+):/) ? $1 : 24;
X
X%options = (
X 'man', 'T:m:P:M:c:s:S:fkltvwdguhaiDK',
X 'apropos', 'm:P:MvduaK',
X 'whatis', 'm:P:M:vduh',
X 'whereis', 'm:P:M:vduh'
X);
X
X($program = $0) =~ s,.*/,,;
X
X$apropos = $program eq 'apropos';
X$whatis = $program eq 'whatis';
X$whereis = $program eq 'whman';
X$program = 'man' unless $program;
X
X&Getopts($options = $options{$program}) || &usage;
X
Xif ($opt_u) {
X &version if $opt_v;
X &usage;
X # not reached
X}
X
Xif ($opt_v) {
X &version;
X exit 0;
X}
X
X&usage if $#ARGV < 0;
X
X$MANPATH = $opt_P if $opt_P; # backwards contemptibility
X$MANPATH = $opt_M if $opt_M;
X
X$want_section = $opt_c if $opt_c; # backwards contemptibility
X$want_section = $opt_s if $opt_s;
X
X$hard_way = $opt_h if $opt_h;
X
Xif ($opt_T) {
X $opt_t = 1;
X $TYPESET =~ s/$TROFF/$opt_T/;
X $TROFF = $opt_T;
X}
X
X$MANPATH = "$MANALT/$opt_m" # want different machine type (undoc)
X if $machine = $opt_m;
X
X$MANSECT = $opt_S if $opt_S; # prefer our own section ordering
X
X$whatis = 1 if $opt_f;
X$apropos = 1 if $opt_k || $opt_K;
X$fromfile = 1 if $opt_l;
X$whereis = 1 if $opt_w;
X$grepman = 1 if $opt_g;
X$| = $debug = 1 if $opt_d;
X$full_index = 1 if $opt_i;
X$show_all = 1 if $opt_a;
X$stripBS = 1 if $opt_D;
X
X$roff = $opt_t ? 'troff' : 'nroff'; # for indirect function call
X
X
X# maybe they said something like 'man vax ls'
Xif ($#ARGV > 0) {
X local($machdir) = $MANALT . '/' . $ARGV[0];
X if (-d $machdir) {
X $MANPATH = $machdir;
X $machine = shift;
X }
X}
X
X at MANPATH = split(/:/,$MANPATH);
X
X# assign priorities to the sections he cares about
X# the nearer the front the higher the sorting priority
X$secidx = 0;
X$delim = ($MANSECT =~ /:/) ? ':' : ' *';
Xfor (reverse split(/$delim/, $MANSECT)) {
X if ($_ eq '') {
X warn "null section in $MANSECT\n";
X next;
X }
X $MANSECT{$_} = ++$secidx;
X}
X
X
Xif ($whatis) {
X &whatis;
X} elsif ($apropos) {
X &apropos;
X} elsif ($whereis) {
X &whereis;
X} elsif ($grepman) {
X &grepman;
X} else {
X &man;
X}
X
Xexit $status;
X
X# --------------------------------------------------------------------------
X# fill out @whatis array with all possible names of whatis files
X# --------------------------------------------------------------------------
Xsub genwhatis {
X local($elt,$whatis);
X
X for $elt (@MANPATH) {
X $whatis = "$elt/whatis";
X push(@whatis, $whatis) if -f $whatis;
X }
X
X die "$program: No whatis databases found, please run makewhatis\n"
X if $#whatis < 0;
X}
X
X# --------------------------------------------------------------------------
X# run whatis (man -f)
X# --------------------------------------------------------------------------
Xsub whatis {
X local($target, %seeking, $section, $desc, @entries);
X
X &genwhatis;
X
X for $target (@ARGV) { $seeking{$target} = 1; }
X
X if ($hard_way) {
X &slow_whatis;
X } else {
X &fast_whatis;
X }
X
X for $target (keys %seeking) {
X print "$program: $target: not found.\n";
X $status = 1;
X }
X}
X
X# --------------------------------------------------------------------------
X# do whatis lookup against dbm file(s)
X# --------------------------------------------------------------------------
Xsub fast_whatis {
X local($entry, $cmd, $page, $section, $desc, @entries);
X
X for $INDEX (@whatis) {
X unless (-f "$INDEX.pag" && dbmopen(INDEX,$INDEX,0444)) {
X warn "$program: No dbm file for $INDEX: $!\n" if $debug;
X #$status = 1;
X if (-f $INDEX) {
X local(@whatis) = ($INDEX); # dynamic scoping obfuscation
X &slow_whatis;
X }
X next;
X }
X for $target (@ARGV) {
X local($ext);
X @entries = &quick_fetch($target,'INDEX');
X next if $#entries < 0;
X # $target =~ s/([^\w])/\\$1/g;
X for $entry (@entries) {
X ($cmd, $page, $section, $desc) = split(/\001/, $entry);
X # STUPID_SO is one that .so's that reference things that
X # don't know they are being referenced. STUPID_SO may cause
X # some peculiarities.
X unless ($STUPID_SO) {
X next unless $cmd =~ /$target/i || $cmd =~ /\.{3}/;
X }
X
X delete $seeking{$target};
X ($ext) = $page =~ /\.([^.]*)$/;
X printf("%-20s - %s\n", "$cmd ($ext)", $desc);
X }
X }
X dbmclose(INDEX);
X }
X
X}
X
X# --------------------------------------------------------------------------
X# do whatis lookup the hard way
X# --------------------------------------------------------------------------
Xsub slow_whatis {
X local($query);
X local($WHATIS);
X
X for (@ARGV) { s/([^\w])/\\$1/g; }
X
X $query = '^[^-]*\b?(' . join('|', at ARGV) . ')\b[^-]* -';
X
X if ($EGREP) {
X if (&run("$EGREP '$query' @whatis")) {
X # pity can't tell which i found
X %seeking = ();
X }
X } else {
X foreach $WHATIS (@whatis) {
X unless (open WHATIS) {
X warn "can't open $WHATIS: $!\n";
X next;
X }
X while (<WHATIS>) {
X next unless /$query/i;
X ($target = $+) =~ y/A-Z/a-z/;
X delete $seeking{$target};
X print;
X }
X close WHATIS;
X }
X }
X}
X
X# --------------------------------------------------------------------------
X# run apropos (man -k)
X# --------------------------------------------------------------------------
Xsub apropos {
X local($_, %seeking, $target, $query);
X &genwhatis;
X
X # fold case on apropos args
X for (@ARGV) {
X y/A-Z/a-z/;
X $seeking{$_} = 1;
X s/(\W)/\\$1/g unless $opt_K;
X }
X $query = join('|', at ARGV);
X
X
X if ($EGREP) {
X # need to fake a -i flag?
X unless ($EGREP =~ /-\w*i/) {
X local($C);
X local(@pat) = split(//,$query);
X for (@pat) {
X ($C = $_) =~ y/a-z/A-Z/ && ($_ = '[' . $C . $_ . ']');
X }
X $query = join('', at pat);
X }
X if (&run("$EGREP '$query' @whatis | $PAGER")) {
X %seeking = ();
X }
X } else { # use perl
X foreach $WHATIS (@whatis) {
X unless (open WHATIS) {
X warn "can't open $WHATIS: $!\n";
X next;
X }
XWHATIS: while (<WHATIS>) {
X next unless /$query/io; # /o ok, because only called once
X $target = $+;
X $target =~ s/\\//g;
X delete $seeking{$query};
X print;
X }
X close WHATIS;
X }
X
X }
X
X for $target (keys %seeking) {
X warn "$program: $target: nothing appropriate\n";
X $status = 1;
X }
X}
X
X# --------------------------------------------------------------------------
X# print out usage message via pager and exit
X# --------------------------------------------------------------------------
Xsub usage {
X unless ($opt_u) {
X warn "usage: $program [-flags] topic ...\n";
X warn " (use -u for long usage message)\n";
X } else {
X open (PIPE, "| $PAGER");
X print PIPE <<USAGE; # in case he wants a page
XUSAGE SUMMARY:
X man [-flags] [section] page[/index] ...
X (section is [1-8lnop], or "new", "local", "public", "old")
X (index is section or subsection header)
X
X man [-flags] -f topic ...
X (aka "whatis")
X
X man [-flags] -k keyword ...
X (aka "apropos")
X
XFLAGS: (most only make sense when invoked as 'man')
X -a show all possible man pages for this topic
X -l file do man processing on local file
X -f topic list table of contents entry for topic
X -k keyword give table of contents entries containing keyword
X -K pattern as -K but allow regexps
X -g pattern grep through all man pages for patterns
X -w topic which files would be shown for a given topic
X -i topic show section and subsection index for use with topic/index
X
X -M path use colon-delimited man path for searching (also as -P)
X -S sects define new section precedence
X
X -t troff the man page
X -T path call alternate typesetter on the man page
X
X -d print out all system() commands before running them
X -h do all lookups the hard way, ignoring any DBM files
X -u this message
X -v print version string
X -D strip backspaces from output
X
XENVIRONMENT:
X \$PAGER pager to pipe terminal-destined output through
X \$MANPATH like -M path
X \$MANSECT like -S sects
X \$MANALT used for alternate hardware types (or obsolete -m flag)
X \$TROFF like -T path
X
XCURRENT DEFAULTS:
X PAGER $PAGER
X MANPATH $MANPATH
X MANSECT $MANSECT
X MANALT $MANALT
X TROFF $TROFF
X
XNOTES: (\$manroot is each component in \$MANPATH)
X * If \$manroot/whatis DBM files do not exist, a warning will be
X printed (if -d flag) and -h will be assumed for that \$manroot only.
X * If \$manroot/tmac.an exists, it will be used for formatting
X instead of the normal -man macros.
X * Man pages may be compressed either in (for example) man1.Z/who.1
X or man1/who.1.Z; cat pages will go into corresponding places.
X * If the man page contains .EQ or .TS directives, eqn and/or tbl
X will be invoked as needed at format time.
XUSAGE
X close PIPE;
X }
X warn "couldn't run long usage message thru $PAGER?!?!\n" if $?;
X exit 1;
X}
X
X# --------------------------------------------------------------------------
X# lookup a given key in the given man root; returns list of hits
X# --------------------------------------------------------------------------
Xsub fetch {
X local($key,$root) = @_;
X local(%recursed);
X
X return $dbmopened{$root}
X ? &quick_fetch($key,$dbm{$root})
X : &slow_fetch($key,$root);
X}
X
X# --------------------------------------------------------------------------
X# do a quick fetch of a key in the dbm file, recursing on indirect references
X# --------------------------------------------------------------------------
Xsub quick_fetch {
X local($key,$array) = @_;
X local(@retlist) = ();
X local(@tmplist) = ();
X local($_, $entry);
X local($name, $ext);
X local(@newlist);
X
X return @retlist unless $entry = eval "\$$array".'{$key};';
X
X if ($@) { chop $@; die "bad eval: $@"; }
X
X @tmplist = split(/\002/, $entry);
X for (@tmplist) {
X if (/\001/) {
X push(@retlist, $_);
X } else {
X ($name, $ext) = /(.+)\.([^.]+)/;
X push(@retlist,
X grep(/[^\001]+\001[^\001]+\001${ext}\001/ || /[^\001]+${ext}\001/,
X &quick_fetch($name, $array)))
X unless $recursed{$name}++;
X # explain and diction are near duplicate man pages referencing
X # each other, requiring the $recursed check. one should be removed
X }
X }
X return @retlist;
X}
X
X# --------------------------------------------------------------------------
X# do a slow fetch for target using perl's globbing notation
X# --------------------------------------------------------------------------
Xsub slow_fetch {
X local($target,$root) = @_;
X local($glob, $stem, $entry);
X
X if ($want_section) {
X if ($MANSECT{$want_section}) {
X $stem = $want_section;
X } else {
X $stem = substr($want_section,0,1);
X }
X $glob = "man$stem*";
X } else {
X $glob = 'man*';
X }
X $glob = "$root/$glob/$target.*";
X return <${glob}>;
X}
X
X# --------------------------------------------------------------------------
X# run 'man -w'
X# --------------------------------------------------------------------------
Xsub whereis {
X local($target, @files);
X
X foreach $target (@ARGV) {
X @files = &find_files($target);
X if ($#files < $[) {
X warn "$program: $target not found\n";
X $status = 1;
X } else {
X print "$target: ";
X for (@files) { print " ", &verify($_); }
X print "\n";
X }
X }
X}
X
X
X# --------------------------------------------------------------------------
X# what are the file names matching this target?
X# --------------------------------------------------------------------------
Xsub find_files {
X local($target) = @_;
X local($root, $entry);
X local(@retlist) = ();
X local(@tmplist) = ();
X local(@entries) = ();
X local($tar_regx);
X local($found) = 0;
X # globals: $vars, $called_before, %dbm, $hard_way (kinda)
X
X $vars = 'dbm00'; # var for magic autoincrementation
X
X ($tar_regx = $target) =~ s/(\W)/\\$1/g; # quote meta
X
X if (!$hard_way && !$called_before++) {
X # generate dbm names
X for $root (@MANPATH) {
X $dbm{$root} = $vars++; # magic incr
X $string = "dbmopen($dbm{$root},\"$root/whatis\",0444);";
X unless (-f "$root/whatis.pag" && eval $string) {
X if ($@) {
X chop $@;
X warn "Can't eval $string: $@";
X } else {
X warn "No dbm file for $root/whatis: $!\n" if $debug;
X }
X #$status = 1;
X next;
X }
X $dbmopened{$root} = 1;
X }
X }
X
X for $root (@MANPATH) {
X local($fullname);
X @tmplist = ();
X if ($hard_way || !$dbmopened{$root}) {
X next unless -d $root;
X warn "slow fetch on $target in $root\n" if $debug;
X @tmplist = &slow_fetch($target,$root);
X } else {
X @entries = &fetch($target,$root);
X next if $#entries < 0;
X
X for $entry (sort @entries) {
X ($cmd, $page, $section, $desc) = split(/\001/, $entry);
X
X # STUPID_SO is so that .so's that reference things that
X # don't know they are being referenced. STUPID_SO may
X # cause peculiarities.
X unless ($STUPID_SO) {
X next unless $cmd =~ /$tar_regx/i || $cmd =~ /\.{3}/;
X }
X push(@tmplist, "$root/man$section/$page");
X }
X }
X push(@retlist, sort bysection @tmplist);
X last if $#retlist >= 0 && $hard_way;
X }
X# unless (@retlist || $hard_way) {
X# # shameless (ab?)use of dynamic scoping
X# local($hard_way) = 1;
X# warn "recursing on find_files\n" if $debug;
X# return &find_files($target);
X# }
X return &trimdups(@retlist);
X}
X
X# --------------------------------------------------------------------------
X# run a normal man command
X# --------------------------------------------------------------------------
Xsub man {
X local($target,$page);
X $isatty = -t STDOUT;
X
X &get_section;
X
X while ($target = shift(@ARGV)) {
X undef $idx_topic;
X
X if (!$fromfile && $target =~ m!^([^/]+)/(.*)!) {
X if (!$isatty) {
X warn "$program: no tty, so no pager to prime with index\n";
X $target = $1;
X } else {
X ($target, $idx_topic) = ($1, $2);
X }
X } else {
X undef $idx_topic;
X }
X
X if ($show_all) {
X local(@pages);
X local($was_defined) = defined $idx_topic;
X @pages = &find_files($target);
X if (!@pages) {
X &no_entry($target);
X next;
X }
X while ($tpage = shift @pages) {
X undef $idx_topic unless $was_defined;
X do $roff(&verify($tpage));
X &prompt_RTN("to read $pages[0]")
X if $roff eq 'nroff' && @pages;
X }
X } else {
X $target = &get_page($target) unless $fromfile;
X do $roff($target) if $target;
X }
X &prompt_RTN("to read man page for $ARGV[0]")
X if $roff eq 'nroff' && @ARGV;
X }
X}
X
X# --------------------------------------------------------------------------
X# find out if he wants a special section and save in $want_section
X# --------------------------------------------------------------------------
Xsub get_section {
X if (!$want_section) {
X local($section) = $ARGV[0];
X $section =~ tr/A-Z/a-z/;
X
X if ($want_section = $SECTIONS{$section}) {
X shift @ARGV;
X } elsif (defined($MANSECT{$section}) || $section =~ /^\d\S*$/i) {
X $want_section = shift @ARGV;
X }
X }
X $want_section =~ tr/A-Z/a-z/;
X
X die "But what do you want from section $want_section?\n"
X if $want_section && $#ARGV < 0;
X}
X
X# --------------------------------------------------------------------------
X# pick the first page matching his target and search orders
X# --------------------------------------------------------------------------
Xsub get_page {
X local($target) = @_;
X local(@found, @want);
X
X unless (@found = &find_files($target)) {
X &no_entry($target);
X return '';
X }
X
X if (!$want_section) {
X @want = @found;
X } else {{
X local($patsect); # in case it's section 3c++
X ($patsect = $want_section) =~ s/(\W)/\\$1/g;
X
X # try exact match first
X last if @want = grep (/\.$patsect$/, @found);
X
X # otherwise how about a subsection
X last if @want = grep (/\.$patsect[^.]*$/, @found);
X
X # maybe it's in the wrong place (mano is notorious for this)
X last if @want = grep (/man$patsect[^.]*\//, @found);
X
X &no_entry($target);
X return '';
X }}
X
X do {
X ($found = &verify($want[0])) || shift @want;
X } until $found || $#want < 0;
X
X return $found;
X}
X
X# --------------------------------------------------------------------------
X# figure out full path name of man page, which may have been compressed
X# --------------------------------------------------------------------------
Xsub verify {
X local($path) = @_;
X local($orig) = $path;
X
X return $path if -f $path;
X
X if ($COMPRESS_PAGE) {
X $path .= '.Z';
X return $path if -f $path;
X $path =~ s/.Z//;
X }
X
X if ($COMPRESS_DIR) {
X $path =~ s-(/[^/]*)$-.Z$1-;
X return $path if -f $path;
X }
X
X warn "$program: $orig has disappeared -- rerun makewhatis\n";
X $status = 1;
X return '';
X}
X
X
X# --------------------------------------------------------------------------
X# whine about something not being found
X# --------------------------------------------------------------------------
Xsub no_entry {
X print STDERR "No manual entry for $_[0]";
X if ($machine || $want_section) {
X print STDERR " in";
X print STDERR " section $want_section of" if $want_section;
X print STDERR " the";
X print STDERR " $machine" if $machine;
X print STDERR " manual";
X }
X print STDERR ".\n";
X $status = 1;
X}
X
X# --------------------------------------------------------------------------
X# order by section. if the complete extension has a section
X# priority, use that. otherwise use the first char of extension
X# only. undefined priorities are lower than any defined one.
X# --------------------------------------------------------------------------
Xsub bysection {
X local ($e1, $e2, $p1, $p2, $s1, $s2);
X
X ($s1, $e1) = $a =~ m:.*/man([^/]+)/.*\.([^.]+)(\.Z)?$:;
X ($s2, $e2) = $b =~ m:.*/man([^/]+)/.*\.([^.]+)(\.Z)?$:;
X
X $e1 = $s1 if $e1 !~ /^${s1}.*/;
X $e2 = $s2 if $e2 !~ /^${s2}.*/;
X
X $p1 = $MANSECT{$e1} || $MANSECT{substr($e1,0,1)};
X
X $p2 = $MANSECT{$e2} || $MANSECT{substr($e2,0,1)};
X
X $p1 == $p2 ? $a cmp $b : $p2 <=> $p1;
X}
X
X# --------------------------------------------------------------------------
X# see whether they want to start at a subsection, then run the command
X# --------------------------------------------------------------------------
Xsub run_topic {
X local($_);
X local($menu_rtn) = defined $idx_topic && $idx_topic eq '';
X {
X &append_sub_topic;
X last if $idx_topic eq "\004";
X if ($idx_topic eq '0') {
X $menu_rtn = 0;
X $idx_topic = '';
X $command =~ s: '\+/[^']*'::;
X }
X $fromfile ? &reformat($command) : &run($command);
X if ($menu_rtn) {
X $idx_topic = '';
X &prompt_RTN("to return to the index");
X $command =~ s! '\+/.*$!!;
X redo;
X }
X }
X
X}
X
X# --------------------------------------------------------------------------
X# run through the typesetter
X# --------------------------------------------------------------------------
Xsub troff {
X local ($file) = $_[0];
X local ($command);
X local ($manroot);
X local ($macros);
X
X ($manroot) = $file =~ m,^(.*)/man([^\.]*)(\.Z)?/([^/]*),;
X
X $command = ((($file =~ m:\.Z:)
X ? $ZCAT
X : $CAT)
X . " < $file | $TYPESET");
X
X $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
X
X &insert_filters($command,$file);
X &run($command);
X}
X
X# --------------------------------------------------------------------------
X# just run a regular nroff, possibly showing the index first.
X# --------------------------------------------------------------------------
Xsub nroff {
X local($manpage) = $_[0];
X local($catpage);
X local($tmppage);
X local($command);
X local(@saveidx);
X local($manroot);
X local($macros);
X local($intmp);
X local(@st_cat, @st_man);
X
X die "trying to nroff a null man page" if $manpage eq '';
X
X umask 022;
X
X if ($full_index) {
X &show_index($manpage);
X return;
X }
X if ($fromfile) {
X $command = (($manpage =~ m:\.Z/:) ? $ZCAT : $CAT)
X . " < $manpage | $CATSET";
X &insert_filters($command, $manpage);
X } else {
X require 'stat.pl' unless defined &Stat;
X # compiled version has this already
X
X
X ($catpage = $manpage)
X =~ s,^(.*)/man([^\.]*)(\.Z)?/([^/]*)$,$1/cat$2/$4,;
X
X $manroot = $1;
X
X # Does the cat page exist?
X if (! -f $catpage && $COMPRESS_DIR){
X # No, maybe it is compressed?
X if (-f "$1/cat$2.Z/$4"){
X # Yes it was.
X $catpage = "$1/cat$2.Z/$4";
X } else {
X # Nope, the cat file doesn't exist.
X # Prefer the compressed cat directory if it exists.
X $catpage = "$1/cat$2.Z/$4"
X if $catpage !~ /\.Z$/ && -d "$1/cat$2.Z";
X }
X }
X
X
X @st_man = &Stat($manpage);
X @st_cat = &Stat($catpage);
X
X if ($st_cat[$ST_MTIME] < $st_man[$ST_MTIME]) {
X
X $command = (($manpage =~ m:\.Z:) ? $ZCAT : $CAT)
X . " < $manpage | $CATSET";
X
X $command = &insert_filters($command, $manpage);
X $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
X
X ($catdir = $catpage) =~ s!^(.*/?cat[^/]+)/[^/]*!$1!;
X
X chdir $manroot;
X
X $tmppage = "$catpage.$$";
X
X unless (-d $catdir && -w _
X && open(tmppage, ">$tmppage") # usually EROFS
X && close(tmppage) )
X {
X $catpage = $tmppage = "/tmp/man.$$";
X $intmp = 1;
X }
X
X printf STDERR "Reformatting page. Please wait ... " if $isatty;
X
X $command .= "| $COMPRESS" if $catpage =~ /\.Z/;
X $command .= "> $tmppage";
X
X $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'TERM'}
X = 'tmp_cleanup';
X
XREFORMAT: { unless (&reformat($command)) {
X warn "$program: nroff of $manpage into $tmppage failed\n";
X unlink $tmppage;
X if (!$intmp++) {
X $catpage = $tmppage = "/tmp/man.$$";
X warn "$program: hang on... retrying into $tmppage\n";
X $command =~ s/> \S+$/> $tmppage/;
X $status = 0;
X redo REFORMAT;
X } else {
X #$status = 1;
X return;
X }
X }}
X warn "done\n" if $isatty;
X
X $intmp || rename($tmppage,$catpage) ||
X die "couldn't rename $tmppage to $catpage: $!\n";
X
X $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'TERM'}
X = 'DEFAULT';
X
X }
X $command = (($catpage =~ m:\.Z:)
X ? $ZCAT
X : $CAT)
X . " < $catpage";
X }
X if (-z $catpage) {
X unlink $catpage;
X die "$program: $catpage was length 0; disk full?\n";
X }
X $command .= "| $UL" if $UL;
X $command .= "| $SED 's/.\b//g'" if $stripBS;
X $command .= "| $PAGER" if $isatty;
X
X &run_topic;
X unlink($tmppage) if $intmp;
X}
X
X
X# --------------------------------------------------------------------------
X# modify $command to prime the pager with the subsection they want
X# --------------------------------------------------------------------------
Xsub append_sub_topic {
X if (defined $idx_topic) {{
X local($key);
X last if $idx_topic eq '0';
X unless ($idx_topic) {
X $idx_topic = &pick_index;
X last if $idx_topic eq "\004" || $idx_topic eq '0';
X }
X if ($idx_topic =~ m!^/!) {
X $command .= " '+$idx_topic'";
X last;
X }
X unless ($key = &find_index($manpage, $idx_topic)) {
X warn "No subsection $idx_topic for $manpage\n\n";
X $idx_topic = '';
X redo;
X }
X $key =~ s/([!-~])/$1.$1/g unless $is_less;
X $command .= " '+/^[ \t]*$key'";
X }}
X}
X
X
X# --------------------------------------------------------------------------
X# present subsections and let user select one
X# --------------------------------------------------------------------------
Xsub pick_index {
X local($_);
X print "Valid sections for $page follow. Choose the section\n";
X print "index number or string pattern. (0 for full page, RTN to quit.)\n\n";
X &show_index;
X print "\nWhich section would you like? ";
X ($_ = <>) ? chop : ($_ = "\004");
X $_ = "\004" if 'quit' =~ /^$_/;
X return $_;
X}
X
X# --------------------------------------------------------------------------
X# strip arg of extraneous cats and redirects
X# --------------------------------------------------------------------------
Xsub unshell {
X $_[0] =~ s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
X $_[0] =~ s/^([^|<]+)<([^Z|<]+)$/$1 $2/;
X ($roff eq 'troff') && $_[0] =~ s#(/usr/man/pr\S+)\s+(\S+)#$2 $1#;
X}
X
X# --------------------------------------------------------------------------
X# call system on command arg, stripping of sh-isms and echoing for debugging
X# --------------------------------------------------------------------------
Xsub run {
X local($command) = $_[0];
X
X &unshell($command);
X
X warn "running: $command\n" if $debug;
X if (system $command) {
X $status = 1;
X printf STDERR "\"%s\" exited %d, sig %d\n", $command,
X ($? >> 8), ($? & 255) if $debug;
X }
X return ($? == 0);
X}
X
X# --------------------------------------------------------------------------
X# check if page needs tbl or eqn, modifying command if needed
X# add known problems for PR directory if applicable
X# --------------------------------------------------------------------------
Xsub insert_filters {
X local($filters,$eqn, $tbl, $_);
X local(*PAGE);
X local($c, $PAGE) = @_;
X local($page,$sect, $prs);
X
More information about the Alt.sources
mailing list