--- /dev/null
+#!/usr/bin/perl -w
+#
+# cfman - make sure manpages have accurate SEE ALSOs
+# tchrist@perl.com
+
+use strict;
+
+my $VERSION = do {
+ my @r = (q$Revision: 1.1 $ =~ /\d+/g);
+ sprintf "%d."."%02d" x $#r, @r;
+};
+
+my $Debug = 0;
+
+my($Ignore_Manpath, $CF_File, $CF_Style,
+ $No_Guessing, $Verbose, $Rebuild_Indices);
+
+parse_opts();
+
+my $Manpath = get_manpath();
+print "MANPATH is $Manpath\n" if $Debug;
+
+check_can_whence();
+
+# (re)set to what we've computed so that when we launch man below,
+# it'll use the specified or inferred manpath.
+
+unless ($Ignore_Manpath) {
+ print "Limiting external manpath\n" if $Debug;
+ $ENV{MANPATH} = $Manpath;
+}
+
+for my $tree (split /:/, $Manpath) {
+ print "tree chdir('$tree')\n" if $Debug > 1;
+ chdir($tree) || die "cannot cd to main tree $tree: $!";
+
+ for my $mandir ( grep { -d } <{man,cat}*> ) {
+ print "subdir chdir('$tree/$mandir')\n" if $Debug > 1;
+ chdir("$tree/$mandir") || die "cannot cd to subdir $tree/$mandir: $!";
+ my($ext, @pages);
+ ($ext = $mandir) =~ s/^(?:cat|man)//;
+ for (@pages = <*.*>) {
+ s/\.gz$//;
+ s/\.(?:0|${ext}\w*)$//;
+ }
+ my $option = adjust_ext($ext);
+ for my $page (@pages) {
+ print "man $option $page\n" if $Debug > 1;
+ open(MAN, "man $option $page 2>&1 | col -b |")
+ or die "cannot fork man lookup: $!";
+ local $/ = '';
+ while (<MAN>) {
+ next unless /^SEE ALSO/ ||
+ $_ eq "S\bSE\bEE\bE A\bAL\bLS\bSO\bO\n";
+ s/.\010//g;
+ s/-\n\s*//g;
+ my @refs = /\S+\(\S+\)/g;
+ print "$page.$ext SEE ALSOs @refs\n" if $Debug > 2;
+ for my $ref (@refs) {
+ my $place = whereis($ref);
+ if ($place =~ /\*\*\*/ || $Debug || $Verbose) {
+ print "$page.$ext: $ref -> $place\n";
+ }
+ }
+ last;
+ }
+ 1 while <MAN>; # drain to suppress broken pipe
+ close(MAN) || warn "close on man $option $page failed";
+ }
+ }
+
+}
+
+sub usage {
+ print STDERR "@_\n" if @_;
+ die "Usage: $0 [-hdrivg] [-f cf-file] [-s cf-style] [mandir ...]\n";
+}
+
+sub run_help {
+ my $pager;
+ unless ($pager = $ENV{PAGER}) {
+ require Config;
+ # lint happiness. blech.
+ $pager = $Config::Config{'pager'} || $Config::Config{'pager'};
+ }
+
+ $pager = "/bin/cat" unless has_cmd($pager);
+
+ if (has_cmd("pod2man") && has_cmd("nroff") ) {
+ { exec("pod2man $0 | nroff -man | $pager") } # lint happiness
+ warn "exec of pod2man | nroff | $pager failed: $!";
+ }
+
+ if (has_cmd("pod2text")) {
+ { exec("pod2text $0 | $pager") } # lint happiness
+ warn "exec of pod2text | $pager failed: $!";
+ }
+
+ # sucks to be you!
+
+ if (eval q{ require Pod::Text; 1; }) {
+ open (STDOUT, "| $pager") || die "no pager $pager: $!";
+ # this forces a wait on child if needed
+ sub END { close(STDOUT) || die "cannot close STDOUT: $!" }
+ Pod::Text::pod2text($0);
+ exit 0;
+ }
+
+ # it REALLY REALLY REALLY sucks to be you!
+ open 0 or die "$0: cannot open myself: $!";
+ $/ = '';
+ while (<0>) {
+ last if /__(END|DATA)__/; # must be careful here
+ }
+ print <0>;
+ exit;
+}
+
+
+sub has_cmd {
+ my $cmd = shift;
+ for (split(/:/, $ENV{PATH})) {
+ my $path = "$_/$cmd";
+ return $path if -f $path && -x _;
+ }
+ return;
+}
+
+sub parse_opts {
+ARG: while (@ARGV && $ARGV[0] =~ s/^-(?=.)//) {
+OPT: for (shift @ARGV) { # getopts is for wimps
+ m/^$/ && do { next ARG; };
+ m/^-$/ && do { last ARG; };
+ s/^d// && do { $Debug++; redo OPT; };
+ s/^i// && do { $Ignore_Manpath++; redo OPT; };
+ s/^g// && do { $No_Guessing++; redo OPT; };
+ s/^v// && do { $Verbose++; redo OPT; };
+ s/^r// && do { $Rebuild_Indices++; redo OPT; };
+ s/^f(.*)// && do { $CF_File = $1 || shift @ARGV; next ARG; };
+ s/^s(.*)// && do { $CF_Style = $1 || shift @ARGV; next ARG; };
+
+ m/^-h(elp)?$/ # stupid fsf broken crappy excuse for real manpages
+ && do { run_help(); exit; };
+
+ usage("unknown option: -$_");
+ }
+ }
+
+ if ($CF_Style && !$CF_File) {
+ for (glob("/etc/man*.c*f*")) {
+ $CF_File = $_;
+ last;
+ }
+ print "Guessed CF file of $CF_File\n" if $Debug;
+ }
+
+}
+
+{ # extra scope for function private "static" variable
+ my $linux_griped = 0;
+ sub get_osname {
+ my $name = $^O;
+
+ if ($name eq 'linux' && ! $linux_griped++
+ && (! $CF_Style || $CF_Style eq 'linux') )
+ {
+ # there are many different linux operating systems, and
+ # it torques me off that they pretend there aren't.
+ # i have no idea whether this works anywhere but redhat.
+ warn "$0: Your osname claims linux; assuming redhat instead\n";
+ }
+
+ return $name;
+ }
+}
+
+
+# everything beneath here should be in a module
+
+{ # extra scope for function private "static" variable
+ my %Whereis;
+ sub whereis {
+ my $manref = shift;
+ my ($page, $ext) = $manref =~ /(\S+)\((\S+)\)/;
+ $ext = lc($ext);
+ return $Whereis{$page, $ext} if $Whereis{$page, $ext};
+ if ($Rebuild_Indices) {
+ $Whereis{$page, $ext} = "*** No manual entry for $page ";
+ if ($Whereis{$page}) {
+ $Whereis{$page, $ext} .= "(really in $Whereis{$page})";
+ }
+ return $Whereis{$page, $ext};
+ }
+
+ my $swext = adjust_ext($ext);
+
+ print "man -w $swext '$page'\n" if $Debug > 1;
+
+ ($Whereis{$page, $ext} = `man -w $swext '$page' 2>&1 `) =~ s/\n/ /g;
+ if ($?) {
+ $Whereis{$page, $ext} =~ s/^/*** /;
+ print "man -w -a '$page'\n" if $Debug > 1;
+ my $try_again = `man -w -a '$page' 2>&1 `;
+ if (! $?) {
+ $try_again =~ s/\n/ /g;
+#/: (\S+)\(([^\s)]+)\).*cat\Q$ext\E.*\b\Q$page\E\.0/
+ if ($try_again =~ /\bcat\Q$ext\E.*\b\Q$page\E\.0/) {
+ $Whereis{$page, $ext} = $try_again;
+ print "BSD REALLY: $page.$ext really in $try_again\n"
+ if $Debug > 1;
+ } else {
+ $Whereis{$page, $ext} =~ s/$/ (really $try_again)/;
+ }
+ }
+ }
+ return $Whereis{$page, $ext};
+ }
+
+ sub check_can_whence {
+ if (! $Rebuild_Indices) {
+ # stupid solaris sh bug. how stupid can these
+ # people be?
+ system "(man -w man) 2>&1 > /dev/null";
+ return unless $?;
+ warn "$0: Your system is stupid: it cannot whence.\n";
+ }
+
+ $Rebuild_Indices++;
+
+ print "$0: Hold on, this may take a while....\n";
+
+ if (get_osname() eq 'solaris') {
+ for my $dir (split /:/, $Manpath) {
+ local *WINDEX;
+ next unless open(WINDEX, "< $dir/windex");
+ print "reading $dir/windex\n" if $Debug;
+ local $_;
+ while (<WINDEX>) {
+ next unless /^(\S+)\s+(\S+)\s+\((\S+)\)/;
+ my ($name, $page, $ext) = ($1, $2, $3);
+ $Whereis{$name} .= "$dir/man$ext/$page.$ext ";
+ $Whereis{$page,$ext} = "$dir/man$ext/$page.$ext";
+ }
+ }
+ }
+ else {
+ for my $tree (split /:/, $Manpath) {
+ print "reading $tree directory entries\n" if $Debug;
+ for my $dir ( glob("$tree/man*") ) {
+ next unless -d $dir;
+ local *DH;
+ opendir(DH, $dir) || die "cannot opendir $dir: $!";
+ my @pages = grep { /[^.].*\./ } readdir(DH);
+ closedir DH;
+ my($section) = $dir =~ /man([^\/]+)$/;
+ for my $page ( @pages ) {
+ my $name;
+ $page =~ s/\.gz$//;
+ my $ext;
+ unless (index($page, ".$section") >= 0) {
+ warn "wrong section for $dir/$page\n";
+ }
+ ($name = $page) =~ s/\.([^.]*)$//;
+ $ext = $1;
+ die "no ext in $page" unless $ext;
+ die "no name" unless $name;
+ $Whereis{$name,$ext} = "$dir/$name.$ext";
+ $Whereis{$name} .= "$dir/$page ";
+ }
+ }
+ }
+ }
+ }
+
+}
+
+# add a -s or a -S or no flag for calling up
+# a page from a particular section
+sub adjust_ext {
+ my $ext = shift;
+ my $osname = $^O;
+
+ if ($osname eq 'solaris') {
+ # stupid solaris REQUIRES this -s crap;
+ # they don't understand -S either
+ $ext = "-s $ext";
+ }
+ elsif ($osname eq 'freebsd') {
+ # stupid freebsd FORBIDS the -s
+ # they also require a -S if it's a two-char word,
+ # like "man 3x curs_util". it doesn't harm in any event,
+ # so do it anyway
+ $ext = "-S $ext";
+ }
+ elsif ($osname eq 'linux') {
+ # stupid redhat FORBIDS the -s;
+ # they tolerate -S, however. but unlike bsd, they
+ # don't seem to require it for 3x sections. interesting.
+ $ext = "-S $ext";
+ }
+ elsif ($osname eq 'openbsd') {
+ # openbsd neither requires nor forbids -s nor -S,
+ # which both mean the same thing.
+ #
+ # then again, they still need it for two-char words,
+ # so do it anyway. Seems dumb. Config issue?
+ $ext = "-S $ext";
+ }
+
+ return $ext;
+}
+
+sub get_manpath {
+ my $pathstr;
+
+ if (@ARGV) {
+ return join ":", @ARGV;
+ }
+
+ if ($ENV{MANPATH} && ! $Ignore_Manpath) {
+ return $ENV{MANPATH};
+ }
+
+ my $osname = get_osname();
+
+ if ($CF_File) {
+ $pathstr = readcf($CF_File, $CF_Style || $osname);
+ return $pathstr if $pathstr;
+ }
+
+ if ($osname eq 'freebsd') {
+ # freebsd has a manpath program
+ $pathstr = run_manpath() || readcf('/etc/manpath.config');
+ }
+ elsif ($osname eq 'openbsd') {
+ # but openbsd does not
+ $pathstr = readcf('/etc/man.conf');
+ }
+ elsif ($osname eq 'linux') {
+ # this sucks - osname should say which linux we have. idiots.
+ $pathstr = readcf('/etc/man.config');
+ }
+ else {
+ if ($CF_File && $CF_Style) {
+ $pathstr = readcf($CF_File, $CF_Style);
+ } else {
+ $pathstr = run_manpath() || compute_manpath();
+ }
+ }
+
+ unless ($pathstr) {
+ for (qw( /usr/man /usr/share/man )) {
+ next unless -d;
+ $pathstr = $_;
+ warn "no manpath set, assuming $_.\n";
+ last;
+ }
+ die "cannot find any manpages" unless $pathstr;
+ }
+
+ return $pathstr;
+
+}
+
+# traverse binpath and guess
+sub compute_manpath {
+ return if $No_Guessing;
+ my (@manpath, %seen);
+ for (split(/:/, $ENV{PATH})) {
+ next if /^\.?$/; # don't care about dot dirs
+ if (s![^/+]*$!man! && -d && !$seen{$_}++) {
+ my($dev,$ino) = stat(_);
+ push(@manpath,$_) unless $seen{$dev,$ino}++;
+ }
+ }
+ print "Guessing manpath of: @manpath\n" if $Debug;
+ return join(":", @manpath);
+}
+
+# try an external manpath program
+sub run_manpath {
+ # the silly subshell is to dodge a solaris bug
+ my $path = `(manpath) 2>/dev/null`;
+ return if $?;
+ chomp $path;
+ return $path;
+}
+
+# try reading config files in various formats
+sub readcf {
+ die "readcf(): expected 1 or 2 args" if @_ < 1 || @_ > 2;
+
+ my($cfpath, $ostype) = @_;
+
+ my $pathfunc;
+
+ my @styles = qw/freebsd openbsd redhat/;
+
+ if (@_ == 2) {
+ $pathfunc = {
+ 'freebsd' => \&cf_freebsd,
+ 'openbsd' => \&cf_openbsd,
+ 'redhat' => \&cf_redhat,
+ 'linux' => \&cf_redhat,
+ }->{$ostype} || die "unknown CF style: $ostype (want @styles)";
+ }
+ else {
+ $pathfunc = {
+ '/etc/manpath.config' => \&cf_freebsd,
+ '/etc/man.conf' => \&cf_openbsd,
+ '/etc/man.config' => \&cf_redhat,
+ }->{$cfpath} || die "no CF reader for $cfpath";
+ }
+
+ local(*CF, $_);
+
+ print "reading CF file $cfpath\n" if $Debug;
+
+ open(CF, "< $cfpath") || die "cannot open $cfpath: $!";
+
+ my(@dir_list, %seen_dir);
+
+ # we're run the guesser first to catch things in the path.
+ unless ($No_Guessing) {
+ for (@dir_list = split /:/, compute_manpath()) {
+ my($dev,$ino) = stat $_;
+ $seen_dir{$dev,$ino} = 1;
+ }
+ }
+
+ while (<CF>) {
+ s/^#.*//;
+ next unless /\S/;
+ for (my @newpaths = &$pathfunc) {
+ # XXX: near-dup code
+ if (-d && !$seen_dir{$_}++) {
+ my($dev,$ino) = stat(_);
+ push(@dir_list,$_) unless $seen_dir{$dev,$ino}++;
+ }
+ }
+ }
+
+ close(CF) || die "cannot close config $cfpath: $!";
+
+ return join ":", @dir_list;
+}
+
+sub cf_freebsd {
+ return $1 if /^\s*MANDATORY_MANPATH\s+(\S+)/;
+ return $1 if /^\s*MANPATH_MAP\s+\S+\s+(\S+)/;
+ return;
+
+}
+
+sub cf_openbsd {
+ return glob($1) if /^\s*_default\s+(.*\S)\s*$/;
+ return glob($1) if /^\s*[^_\s]\S+\s+(.*\S)\s*$/;
+ return;
+}
+
+sub cf_redhat {
+ return $1 if /^\s*MANPATH\s+(\S+)/;
+ return $1 if /^\s*MANPATH_MAP\s+\S+\s+(\S+)/;
+ return;
+}
+
+__END__
+
+=head1 NAME
+
+cfman - make sure manpages have accurate SEE ALSOs
+
+=head1 SYNOPSIS
+
+B<cfman> [B<-hdrivg>]
+[B<-f> I<cf-file>] [-B<s> I<cf-style>] [I<mantree> ...]
+
+=head1 DESCRIPTION
+
+The B<cfman> program attempts to search your system manpages for SEE
+ALSO entries that are incorrect. To determine which manpages to look at,
+the system's manpage directories are searched. However, to look at the
+SEE ALSO list, the man(1) program is called. That's because some systems
+have funny ideas about whether pages are installed already formatted
+or not.
+
+For each SEE ALSO reference, we attempt to call B<man -w> on a
+particular page in the references section or subsection it
+to figure out the real path. If this fails, we call B<man -w -a>
+irrespective of section. If it's found somewhere it's not expected,
+we still report the problem, as we do if it's not found at all.
+
+On systems too primitive to support the useful B<man -w> syntax, we
+try to figure it out by hand by reading all the directories first.
+On Solaris, we'll look at the I<windex> files in each directory.
+You can force this behaviour by using the B<-r> option described below.
+
+=head1 OPTIONS
+
+Most options can be clustered.
+
+=over
+
+=item -d
+
+Run with debugging. This option is cumulative. Currently
+debugging level one through three are provided.
+
+=item -f I<cf-file>
+
+Specify a man(1) config file to read in if need be.
+
+=item -g
+
+Disable guessing of manpage using current PATH variable.
+
+=item -h
+
+Give a help message. Actually, try valiantly to give this manpage,
+even if it's not installed. It's very hard to misplace this one. :-)
+
+=item -i
+
+Ignore the current manpage. This has two effects. First, it means
+that the program will not consult the MANPATH variable for default
+paths. Secondly, it will not attempt to reset the MANPATH variable
+before calling man(1) to do its work. See examples below.
+
+=item -r
+
+Rebuild indices of what is installed where manually. This is a simplistic
+check only. We consult each I<man*> subdirectory beneath each element
+in the list of supplied man directories, and within that, we look for
+each page inside. This is necessary on systems that don't support
+a B<-w> option to man(1), and will be inferred if needed. It may
+be faster than running B<man -w> that often.
+
+=item -s I<cf-style>
+
+Supply a parsing style for the config files. Only three are currently
+supported: B<openbsd>, B<freebsd>, and B<redhat>.
+
+=item -v
+
+Verbose mode. This just means that it will show where all the
+SEE ALSO references apppear to resolve to, not merely report
+the missing or misdirected ones.
+
+=back
+
+=head1 EXAMPLES
+
+Run the program using the current manpath if set, or the
+system one otherwise:
+
+ $ cfman
+
+Run the program against the listed mantrees only. References
+to something outside those trees will fail:
+
+ $ cfman /usr/man /usr/X11R6/man
+
+Run on one tree only, but do not restrict references to being
+in those trees only:
+
+ $ cfman -i /usr/local/perl/man
+
+=head1 ENVIRONMENT
+
+=over
+
+=item MANPATH
+
+The user's current MANPATH is used unless the B<-i> option
+is supplied.
+
+=item PAGER
+
+This is used to feed the the self-generating manapge into.
+
+=item PATH
+
+This is used if we need to guess a MANPATH.
+
+=back
+
+=head1 FILES
+
+The system-wide config file (such as I</etc/man.conf>, I</etc/man.config>,
+or I</etc/manpath.config>) is used if it's needed.
+
+Numerous B<man>-related directories and files will be grovelled through,
+both directly and indirectly.
+
+The B<pod2man>, B<pod2text>, and B<nroff> programs may also be called
+for the self-generating manpage in the help message, as may your
+B<more> program or preferred pager.
+
+=head1 SEE ALSO
+
+In no particular order: catman(1), man(1), manpath(1), more(1), nroff(1),
+pod2man(1), pod2text(1), whatis(1), man.conf(5), man(7), and noman(8).
+
+=head1 NOTES
+
+The B<-w> option to the man(1) program was first introduced in the work
+presented at the 1990 Usenix LISA conference in Colorado Springs in the
+paper entitled title I<The Answer to All Man's Problems>. This option,
+along with several others invented there, have since been adopted by all
+modern Unixes. Other work presented in that paper included an earlier
+version of this program. Sadly, vendors have been negligently remiss
+in their duties since that time.
+
+The paper is available upon request from the author. It uses the ms(7)
+macro set. You have been warned. :-)
+
+=head1 DIAGNOSTICS
+
+Classes of diagnostics are as follows.
+
+=over
+
+=item N
+
+A normal message. This is the program's expected output.
+
+=item D1
+
+A level-one debugging message.
+
+=item D2
+
+A level-two debugging message.
+
+=item W
+
+A warning.
+
+=item WI
+
+An internal warning, with extra diagnostics appended
+telling the file name and line number of the problem.
+
+=item F
+
+A fatal error.
+
+=item FI
+
+An internal fatal error, with extra diagnostics appended
+telling the file name and line number of the problem.
+
+=back
+
+Any instances of C<%s> below are replaced with a string in the actual
+error message. Any instances of C<%M> below are replaced with the
+current errno string.
+
+=over
+
+=item %s: %s -> %s
+
+(N) Where a reference resolves to. The first field is the page being
+consulted. The second field is what it contains. The third field
+is where the reference solves to. If there is no resolution, then a
+message beginning with three stars will be emitted. In some cases,
+a parenthesized suggestion is made.
+
+=item cannot fork man lookup: %m
+
+(FI) Tried to run the man(1) program to parse output, but
+couldn't. Usually means out of processes; or sometimes,
+command not found.
+
+=item cannot cd to main tree %s: %m
+
+(FI) One of the elements in the MANPATH was inaccessible.
+
+=item cannot cd to subdir: %m
+
+(FI) One of the subdirectories in one of the MANPATH elements was
+inaccessible.
+
+=item cannot close config %s: %m
+
+(FI) The config file wouldn't close properly.
+
+=item cannot close STDOUT: %m
+
+(FI) The pager used for the help manpage wouldn't close properly.
+
+=item cannot find any manpages
+
+(FI) Unable to figure out a manpage any other way,
+we tried looking in I</usr/man> and I</usr/share/man>,
+but those weren't there.
+
+=item cannot open myself: %m
+
+(FI) In the worst case, we open our own program file to
+produce a help page. But that open failed. Strange.
+
+=item cannot opendir %s: %m
+
+(FI) One of the subdirectories in a man tree
+was inaccessible.
+
+=item close on man %s failed
+
+(WI) We were unable to correctly close the pipe
+from man(1) we were running to read its SEE ALSO entries.
+
+=item exec of pod2man | nroff | %s failed: %m
+
+(WI) We couldn't pod2manify ourselves. Usually this is just
+a broken pipe because you exited early.
+
+=item exec of pod2text | %s failed: %m
+
+(WI) We couldn't pod2textify ourselves. Usually this is just
+a broken pipe because you exited early.
+
+=item Guessed CF file of %s
+
+(D1) You specified a parsing style, but no file.
+So we guessed one. We look in I</etc/man*.c*f*> for a match.
+
+=item Guessing manpath of: %s
+
+(D1) We ran down your binpath and suspected that these
+were valid man directories for each piece.
+
+=item Hold on, this may take a while....
+
+(N) We have to exhaustively read each directory looking for
+manpages. This is not fast. But in the end, it might be
+faster than calling B<man -w> a zillion times. You can enable
+this with the C<-r> flag.
+
+=item Limiting external manpath
+
+(D1) The MANPATH envariable is set before
+calling man(1) again.
+
+=item man %s %s
+
+(D2) We're calling man(1) to parse the SEE ALSO references.
+
+=item man -w %s '%s'
+
+(D2) We're trying to look up the path where a manpath is located.
+
+=item man -w -a %s'%s'
+
+(D2) We're trying harder look up the path where a manpath is located
+because the first try failed.
+
+=item MANPATH is %s
+
+(D1) This is the colon-separated list of mantree directories
+we decided to process.
+
+=item no CF reader for %s
+
+(X) The path has no known syntax.
+
+=item no ext in %s
+
+(X) We couldn't figure out the subsection by looking for an
+extension.
+
+=item no manpath set, assuming %s.
+
+(W) We're trying to use a hard-coded path, becuase
+nothing else worked.
+
+=item no name
+
+(X) Couldn't figure out the name of the page, given the
+filename.
+
+=item no pager %s: %m
+
+(FI) You don't seem to have a valid pager.
+
+=item readcf(): expected 1 or 2 args
+
+(X) Internal error. A function was called wrong.
+
+=item reading CF file %s
+
+(D1) We're parsing this file for man config entreies.
+
+=item reading %s directory entries
+
+We're reading all the manpages in this directory.
+Probably because you used B<-r> or because you have
+a primitive and annoying man(1) program.
+
+=item reading %s/windex
+
+=item subdir chdir('%s')
+
+(D2) This message is printed each time we change
+to a subdirectory within a mantree.
+N This is the program's expected output. The first
+
+=item tree chdir('%s')
+
+(D2) This message is printed each time we change
+directory to a new mantree.
+
+=item unknown CF style: %s (want %s)
+
+(FI) You asked for a config-file parsing style that
+we don't support.
+
+=item unknown option: -%s
+
+(FI) You specified an invalid option. This will trigger
+a usage message.
+
+=item Usage: %s [-hdrivg] [-f cf-file] [-s cf-style] [mandir ...]
+
+(N) The usage message.
+
+=item wrong section for %s/%s
+
+(W) While searching your directories, we found a strange
+page, such as I<vi.man> installed in the I<man1> directory,
+where we were expecting I<vi.1> instead.
+
+=item Your osname claims linux; assuming redhat instead
+
+(W) It is unclear to this author whether all the different
+Linux operating systems employ the same man(1) program.
+It seems imprudent to assume that the version of the
+operating system (read: the kernel) has anything to do with
+the installed utility set. uname(1) is not helpful here.
+You may suppress this message by explicitly using B<-s redhat>.
+
+=item Your system is stupid: it cannot whence.
+
+(W) Your system is too primitive to support B<man -w>.
+This makes us do things the hard way.
+
+=head1 BUGS
+
+Various, no doubt.
+
+=head1 RESTRICTIONS
+
+This program was tested only under a couple different of BSD operating
+systems and a couple of different Linux operating systems. Remedial
+support for Solaris is included, but has not been stress tested.
+Bugs in their I<windex> files messages up this program.
+
+=head1 AUTHOR
+
+Tom Christiansen <tchrist@perl.com>
+
+=head1 HISTORY
+
+Version 1: Sometimes in early 1989.
+
+Version 2: December 15th, 1989.
+
+Version 3: October 20th, 1999. Just made it in under the decade mark.
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# scatman - find turds in mantrees
+# tchrist@perl.com
+
+use strict;
+
+my ($Manpath, $Debug);
+
+parse_opts();
+
+MANTREE:
+for my $tree (split /:/, $Manpath) {
+ debug("chdir($tree)");
+ chdir($tree) || die "cannot cd to main tree $tree: $!";
+
+ # XXX: doesn't handles openbsd recursive mandirs yet
+
+MANDIR:
+ #for my $mandir ( grep { -d } <{man,cat}*> ) {
+ my @mandirs = grep { -d } <{cat,man}*>;
+ while (@mandirs) {
+ my $mandir = shift @mandirs;
+ my $was_catted = $mandir =~ /^cat/;
+ debug("chdir($tree/$mandir)");
+ chdir("$tree/$mandir") || die "cannot cd to subdir $tree/$mandir: $!";
+
+ my($dirext) = ($mandir =~ /^(?:cat|man)(.*)/);
+ my($ext, @pages);
+
+ local *MANDIR;
+ unless (opendir(MANDIR, ".")) {
+ die "$0: can't opendir . while in $tree/$mandir: $!\n";
+ }
+
+MANPAGE:
+ while (my $file = readdir(MANDIR)) {
+ next MANPAGE if $file =~ /^\.\.?$/;
+ my $path = "$tree/$mandir/$file";
+ if (-l $file) {
+ my $target = readlink($file);
+ debug("readlink on $path -> $target");
+ unless (-f $target && -r $target) {
+ print "$path: bad symlink ($target)\n";
+ }
+ next MANPAGE;
+ }
+ if (-d $file) {
+ push @mandirs, "$mandir/$file";
+ next;
+ }
+ unless (-f $file) {
+ print "$path: not a plain file\n";
+ next MANPAGE;
+ }
+
+ unless ($file =~ /\./) {
+ print "$path: doesn't smell like a manpage to me\n";
+ next MANPAGE;
+ }
+
+ unless ($file =~ /\.${dirext}\S*(\.(gz|Z))?$/
+ # get a real man dang you!
+ || ($was_catted && $file =~ /\.0/)
+ )
+ {
+ print "$path: strange extension for this directory\n";
+ }
+
+ my $openspec = ($file =~ /\.(gz|Z)$/)
+ ? "gzip -dc < $file |"
+ : "< $file";
+
+ local *FH;
+ debug("open $openspec");
+ unless (open(FH, $openspec)) {
+ warn "can't open $openspec: $!\n";
+ next;
+ }
+
+ my($saw_TH, $saw_DOT, $over_struck);
+ local $_;
+MANLINE:
+ while (<FH>) {
+ $saw_DOT += /^['.]/;
+ $saw_TH += m{
+ ^ [.'] # ' unlikely but possible
+ \s* # optional white space
+ (?:
+ TH # -man version
+ | Dt # -mandoc version
+ )
+ \b
+ }x;
+ if (/^['.]\s*so\s+(\S+)/) {
+ my $link = $1;
+ my $sofile = $link =~ m#^/#
+ ? $link
+ : "$tree/$link"; # not $mandir!
+ debug("$path: so's to $sofile");
+ unless (-f $sofile && -r $sofile) {
+ print "$path: bad solink: $link\n";
+ }
+ close FH;
+ next MANPAGE;
+ }
+ if (!defined $over_struck) {
+ $over_struck++ if /(.)[\b]\1/;
+ }
+ close FH,last if $saw_DOT && $saw_TH;
+ }
+ close FH;
+ if ($saw_DOT) {
+ unless ($saw_TH) {
+ print "$path: missing title macro\n";
+ }
+ }
+ else {
+ if ($over_struck) {
+ my $wish = "$tree/cat$dirext/$file";
+ print "$path: this catpage should be in $wish"
+ unless $path eq $wish;
+ } else {
+ print "$path: doesn't look like nroff, maybe ",
+ `file $path 2>&1` =~ /: (.*)/, "\n";
+ }
+ }
+
+ }
+ }
+}
+
+sub debug {
+ print "[ @_ ]\n" if $Debug;
+}
+
+sub usage {
+ print STDERR "@_\n" if @_;
+ die "Usage: $0 [ -h ] [ -d ] [ [ -M ] [ manpath ] ]\n";
+}
+
+sub run_help {
+ my $pager;
+ unless ($pager = $ENV{PAGER}) {
+ require Config;
+ # lint happiness. blech.
+ $pager = $Config::Config{'pager'} || $Config::Config{'pager'};
+ }
+
+ $pager = "/bin/cat" unless has_cmd($pager);
+
+ if (has_cmd("pod2man") && has_cmd("nroff") ) {
+ { exec("pod2man $0 | nroff -man | $pager") } # lint happiness
+ warn "exec of pod2man | nroff | $pager failed: $!";
+ }
+
+ if (has_cmd("pod2text")) {
+ { exec("pod2text $0 | $pager") } # lint happiness
+ warn "exec of pod2text | $pager failed: $!";
+ }
+
+ # sucks to be you!
+
+ if (eval q{ require Pod::Text; 1; }) {
+ open (STDOUT, "| $pager") || die "no pager $pager: $!";
+ # this forces a wait on child if needed
+ sub END { close(STDOUT) || die "cannot close STDOUT: $!" }
+ Pod::Text::pod2text($0);
+ exit 0;
+ }
+
+ # it REALLY REALLY REALLY sucks to be you!
+ open 0 or die "$0: cannot open myself: $!";
+ $/ = '';
+ while (<0>) {
+ last if /__(END|DATA)__/; # must be careful here
+ }
+ print <0>;
+ exit;
+}
+
+
+sub has_cmd {
+ my $cmd = shift;
+ for (split(/:/, $ENV{PATH})) {
+ my $path = "$_/$cmd";
+ return $path if -f $path && -x _;
+ }
+ return;
+}
+
+sub parse_opts {
+ARG: while (@ARGV && $ARGV[0] =~ s/^-(?=.)//) {
+OPT: for (shift @ARGV) { # getopts is for wimps
+ m/^$/ && do { next ARG; };
+ m/^-$/ && do { last ARG; };
+ s/^d// && do { $Debug++; redo OPT; };
+ s/^M(.*)// && do { $Manpath = $1 || shift @ARGV; next ARG; };
+
+ m/^(h|-help)?$/ # stupid fsf broken crappy excuse for real manpages
+ && do { run_help(); exit; };
+
+ usage("unknown option: -$_");
+ }
+ }
+
+ if (@ARGV) {
+ usage("Manpath set, but arguments remaining") if $Manpath;
+ usage("Too many arguments") if @ARGV > 1;
+ $Manpath = $ARGV[0];
+ }
+ else {
+ $Manpath = '/usr/share/man';
+ }
+
+}
+
+__END__
+
+=head1 NAME
+
+scatman - find turds in mantrees
+
+=head1 SYNOPSIS
+
+B<scatman> S<[ B<-h> ]> S<[ B<-d> ]> S<[ [ B<-M> ] [ I<manpath> ] ]>
+
+=head1 DESCRIPTION
+
+The B<scatman> program locates things in man directories that
+shouldn't be there. It looks for stray files, catpage installed
+where manpage belong, non-troff files, troff files without proper
+title macros, wrong symbolic links, wrong C<.so> links, manpages
+installed with odd extensions, and unreadable files.
+
+The B<-d> flag adds debugging.
+
+The B<-M> I<manpath> flag is there for compatibility with
+other manly programs.
+
+The B<-h> flag prints this manpage and exit. You cannot lose
+this manpage. No more whingeing!
+
+=head1 SEE ALSO
+
+man(1), man(7), mandoc(7), cfman(8), noman(8)
+
+=head1 RESTRICTIONS
+
+This program has only been tested on the Redhat operating system.
+
+=head1 AUTHOR
+
+Tom Christiansen <tchrist@perl.com>
+
+=head1 HISTORY
+
+
+Version 1: 24 October 1999
+
+
projects / openbsd / commitdiff