home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / man.shar / man / makewhatis < prev    next >
Encoding:
Text File  |  1991-03-04  |  11.1 KB  |  450 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # makewhatis: perl rewrite for makewhatis
  4. # author: tom christiansen <tchrist@convex.com>
  5. #
  6. # Copyright 1990 Convex Computer Corporation.
  7. # All rights reserved.
  8.  
  9. eval "exec /usr/bin/perl -S $0 $*"    # some bozo called us with 'sh foo'
  10.     if $running_under_some_shell;     #   'catman -w' likes to do this; sigh
  11.  
  12.  
  13. &source('stat.pl');
  14.  
  15. ($program = $0) =~ s,.*/,,;
  16.  
  17. $UNCOMPRESS = "uncompress";
  18.  
  19. $MAXWHATISLEN =  300;   
  20. $MAXDATUM     = 1024;     # DBM is such a pain
  21.  
  22. umask 022;
  23.  
  24. &source('getopts.pl');
  25.  
  26. do Getopts('ynvdP:M:') || &usage;
  27.  
  28. $opt_P = shift if $#ARGV >= 0;
  29.  
  30. &usage if $#ARGV > -1;
  31.  
  32. sub usage { die "usage: $program [-n] [-y] [-v] [[-M] manpath]\n"; } 
  33.  
  34. $nflag = $opt_n;
  35. $yflag = $opt_y;
  36.  
  37. $manpath = $opt_M if $opt_M;
  38. $manpath = $opt_P if $opt_P;        # backwards contemptibility
  39. $manpath = "/usr/man" unless $manpath;
  40. @manpath = split(/:/,$manpath);
  41.  
  42. $| = $debug = ($opt_d || $opt_v);
  43.  
  44. $SIG{'INT'}  = 'CLEANUP';
  45. $SIG{'TERM'} = 'CLEANUP';
  46.  
  47. $SIG{'HUP'}  = 'IGNORE';
  48.  
  49. chop($cwd = `pwd`);
  50.  
  51. $WHATIS = "whatis";
  52.  
  53. # ---------------------------------------------------------------------------
  54. # main loop
  55. #
  56. # chdir to each root in man path.  save mtime of dbase for later compares
  57. # with files in case of nflag or yflag.   
  58. # ---------------------------------------------------------------------------
  59.  
  60. $| = 1;
  61.  
  62. foreach $root ( @manpath ) {
  63.     local($dbtime, $filecount, $entries);
  64.  
  65.     $root = "$cwd/$root" if $root !~ m:^/:;  # normalize to fullpathname
  66.     chdir $root || (warn "can't chdir to $root: $!", next);
  67.  
  68.     print "$program: processing man tree $root...\n";
  69.  
  70.     if ($nflag || $yflag) { 
  71.     unless (&Stat('whatis.pag')) {
  72.         print "couldn't stat $root/whatis DBM file\n" if $debug;
  73.         &rebuild(0, 0) if $yflag;
  74.         next;
  75.     }
  76.     $dbtime = $st_mtime;
  77.     }
  78.     &rebuild($nflag, $yflag);
  79. }
  80.  
  81. exit $status;
  82.  
  83. # ---------------------------------------------------------------------------
  84. # rebuild -- open a new whatis database, store all references in files in 
  85. #          this root to it.  if dont_touch or test_stale parms set, just
  86. #         do the checks.  if test_stale, recurse on a real rebuild.
  87. # ---------------------------------------------------------------------------
  88.  
  89. sub rebuild {
  90.     local($dont_touch, $test_stale) = @_;
  91.  
  92.     local(%seen);        # {dev,ino} pairs of files seen
  93.     local(%so);            # the .so references seen
  94.     local(@WHATIS);        # whatis list
  95.     local($entries, $filecount) = (0,0);
  96.  
  97.     unless ($dont_touch || $test_stale) {
  98.     if (!open (WHATIS, "> $WHATIS.$$")) {
  99.         warn "can't open $root/$WHATIS.$$: $!\n";
  100.         $status = 1;
  101.         return;;
  102.     }
  103.     if (!dbmopen(WHATIS, "$WHATIS.$$", 0644)) {
  104.         warn "can't dbmopen $root/$WHATIS: $!\n";
  105.         $status = 1;
  106.         return;
  107.     }
  108.     }
  109.  
  110.     foreach $mandir ( <man?*> ) {
  111.     next if $mandir =~ /man0.*/;
  112.     next if $mandir =~ /\.(old|bak)$/i;
  113.     next if $mandir =~ /~$/;
  114.     next unless -d $mandir;
  115.  
  116.     if (!chdir $mandir) {
  117.         warn "can't chdir to $root/$mandir: $!\n";
  118.         next;
  119.     }
  120.  
  121.     ($dirext) = $mandir =~ /man(.*)$/;
  122.     $dirext =~ s/\.Z$//;
  123.  
  124.     print "subdir is $mandir\n" if $debug;
  125.  
  126.     if (!opendir(mandir,'.')) {
  127.         warn "can't opendir('$root/$mandir'): $!\n";
  128.         next;
  129.     }
  130.  
  131.     # read each file in directory.  use readdir not globbing
  132.     # because we don't want to blow up on huge directories
  133. FILE:    while ($FILE = readdir(mandir)) {
  134.         $compressed = $mandir =~ m:.*\.Z:;
  135.         next FILE if $FILE =~ /^\.{1,2}/;
  136.  
  137.         if ($FILE !~ /\S\.[^Z\s]/) {
  138.         print STDERR "Skipping non-man file: $root/$mandir/$FILE\n";
  139.         next FILE;
  140.         } 
  141.  
  142.         # this will be optimized into a case statement
  143.         if      ($FILE =~ /\.old(\.Z)?$/i) {
  144.         next;
  145.         } elsif ($FILE =~ /\.bak(\.Z)?$/i) {
  146.         next;
  147.         } elsif ($FILE =~ /\.out(\.Z)?$/i) {
  148.         next;
  149.         } elsif ($FILE =~ /~(\.Z)?$/) {
  150.         next;
  151.         }
  152.  
  153.         ($tmpfile = $FILE) =~ s/\.Z$//;
  154.  
  155.         ($filenam, $filext) = 
  156.         $tmpfile =~ /^(\S+)\.([^.]+)$/;
  157.  
  158.         #if ($filext eq '.Z') {
  159.         #($filenam, $filext) = $filenam =~ /^(\S+)\.([^.]+)(\.Z)?$/;
  160.         #}
  161.  
  162.         if ($filext !~ /^${dirext}.*/ && $mandir ne 'mano') {
  163.         print STDERR "$FILE has a funny extension to be in $root/$mandir\n";
  164.         }
  165.  
  166.         unless (&Stat($FILE)) {
  167.         warn "can't stat $root/$mandir/$FILE: $!\n";
  168.         next FILE;
  169.         } 
  170.  
  171.         if ($dont_touch || $test_stale) {
  172.         next unless $st_mtime > $dbtime;
  173.         print "$root/$mandir/$FILE newer than its dbm whatis file\n";
  174.         closedir mandir;
  175.         chdir $root;
  176.         &rebuild(0,0) if $test_stale;
  177.         return;
  178.         }
  179.  
  180.         if ($apage = $seen{$st_dev,$st_ino}) {
  181.         printf "already saw %s, linked to %s\n", $FILE, $apage
  182.             if $debug;
  183.         &chopext($page = $FILE);
  184.         unless ($WHATIS{$page}) {
  185.             print "forgot $page\n" if $debug;
  186.             $apage =~ s/\.Z$//;
  187.             &store_indirect($page, $apage);
  188.         }
  189.         next FILE;
  190.         } 
  191.         $seen{$st_dev,$st_ino} = $FILE;
  192.  
  193.         $compressed |= $FILE =~ /\.Z$/;
  194.         
  195.         if (!open(FILE, $compressed ? "$UNCOMPRESS < $FILE |" : $FILE)) {
  196.         warn "can't open $FILE: $!\n";
  197.         next FILE; 
  198.         }
  199.  
  200.         $filecount++;
  201.         print "opened $root/$mandir/$FILE\n" if $debug;
  202.  
  203.         &extract_names;
  204.     } 
  205.     closedir mandir;
  206.     chdir $root || die "can't chdir back to $root: $!";
  207.     } 
  208.  
  209.     unless ($dont_touch || $test_stale) {
  210.     $, = "\n";
  211.     print WHATIS (sort @WHATIS),'';
  212.     $, = '';
  213.     close WHATIS || warn "can't close $WHATIS.$$: $!";
  214.     rename ("$WHATIS.$$", $WHATIS) 
  215.         || warn "can't rename $WHATIS.$$ to $WHATIS: $!";
  216.     &check_sos();
  217.     dbmclose(WHATIS) || warn  "can't dbmclose $WHATIS: $!";
  218.     for $ext ( 'pag', 'dir' ) {
  219.         unlink "$WHATIS.$ext"; 
  220.         rename("$WHATIS.$$.$ext", "$WHATIS.$ext")
  221.         || warn "can't rename $WHATIS.$$.$ext:  $!";
  222.     } 
  223.     print "$program: $root: found $entries entries in $filecount files\n";
  224.     } 
  225. } 
  226.  
  227.  
  228. # in case we get interrupted
  229. #
  230. sub CLEANUP {
  231.     print stderr "<<INTERRUPTED>> reading $FILE\n";
  232.     chdir $root;
  233.     unlink "$WHATIS.$$", "$WHATIS.$$.pag", "$WHATIS.$$.dir";
  234.     exit 1;
  235. } 
  236.  
  237. # get next line from FILE, honoring escaped newlines
  238. #
  239. sub getline {
  240.     local ($_);
  241.  
  242.     $_ = <FILE>;
  243.     {
  244.         chop;
  245.         if (/\\$/) {
  246.             chop;
  247.             $_ .= ' ';
  248.             $_ .= <FILE>;
  249.             redo;
  250.         }
  251.     }
  252.     $_;
  253. }
  254.  
  255. sub extract_names {
  256.     local($_);
  257.     local($needcmdlist) = 0;
  258.     local($foundname) = 0;
  259.     local(@lines);
  260.     local($page, $page2, $indirect, $foundname, @lines, $nameline);
  261.     local($cmdlist, $ocmdlist, $tmpfile, $section);
  262.     local($prototype, $seenpage);
  263.  
  264.     unless (-T FILE) {
  265.     print STDERR "$FILE: not a text file\n";
  266.     next;
  267.     } 
  268.  
  269.  
  270.     $_ = <FILE>;     #   first check for leading .so reference
  271.     if (/^\.so\s+(man.+\/\S+)/) {
  272.     local($indirect, $indirect2);
  273.     $indirect = $1;
  274.     ($page)  = $FILE     =~ m:([^.]+)\.[^.]*$:;
  275.     ($page2) = $indirect =~ m:.*/([^/]+)$:;
  276.     ($indirect2 = $indirect) =~ s!/!.Z/!;
  277.     if (-e "../$indirect" || -e "../$indirect.Z" || -e $indirect2) {
  278.         $so{$page} = $page2;
  279.         print "$FILE: .so alias for $indirect\n" if $debug;
  280.     } else {
  281.         print STDERR "$FILE .so references non-existent $indirect\n";
  282.     }
  283.     return;
  284.     } else {
  285.     /^\.TH\s+(\S*)\s+(\S+)/ && &doTH($1, $2);
  286.     } 
  287.  
  288. LINE: while (<FILE>) {
  289.     /^\.TH\s+(\S*)\s+(\S+)/ && &doTH($1, $2);
  290.     next LINE unless /^\.SH\s+"?NAME"?/i || /^\.NA\s?/;
  291.     $foundname = 1;
  292.     @lines = ();
  293.     $nameline = '';
  294. NAME:    while ($_ = &getline()) {
  295.         last NAME if /^\.(S[hHYS])\s?/;  # MH support
  296.         if ( $_ eq '.br' ) {
  297.         push(@lines, $nameline) if $nameline;
  298.         $nameline = '';
  299.         next NAME;
  300.         } 
  301.         s/^\.[IB]\b//;    # Kill Bold and Italics
  302.         next if /^\./;
  303.         $nameline .= ' ' if $nameline;
  304.         $nameline .= $_;
  305.     } 
  306.  
  307.     push(@lines, $nameline);
  308.  
  309.     for ( @lines ) {
  310.         next unless ord;
  311.         s/\\f([PBIR0-4]|\(..)//g;    # kill font changes
  312.         s/\\s[+-]?\d+//g;        # kill point changes
  313.         s/\\&//g;            # and \&
  314.         s/\\\((ru|ul)/_/g;        # xlate to '_'
  315.         s/\\\((mi|hy|em)/-/g;    # xlate to '-'
  316.         s/\\\*\(..//g  &&        # no troff strings
  317.         print STDERR "trimmed troff string macro in NAME section of $FILE\n";
  318.         s/\\//g;               # kill all remaining backslashes 
  319.         s/^\.\\"\s*//;        # comments
  320.         if (!/\s*-+\s+/) {
  321.         #        ^ otherwise L-devices would be L
  322.         printf STDERR "$FILE: no separated dash in \"%s\"\n", $_;
  323.         $needcmdlist = 1;       # forgive their braindamage
  324.         s/.*-//;
  325.         $desc = $_;
  326.         } else {
  327.         ($cmdlist, $desc) = ( $`, $' );
  328.         $cmdlist =~ s/^\s+//;
  329.         }
  330.  
  331.         # need this for two reasons: sprintf might blow up and so 
  332.         # might the dbm store due to 1k limit
  333.         #
  334.         $ocmdlist = $cmdlist;  # before truncation
  335.         if (length($cmdlist) > $MAXWHATISLEN) {
  336.         printf STDERR "$FILE: truncating cmdlist from %d to %d bytes for DBM's sake\n",
  337.             length($cmdlist), $MAXWHATISLEN;
  338.         $cmdlist = substr($cmdlist,0,$MAXWHATISLEN) . "...";
  339.         } 
  340.  
  341.         ($tmpfile = $FILE) =~ s/\.Z$//;
  342.         ($page, $section) = $tmpfile =~ /^(\S+)\.(\S+)$/;
  343.         $cmdlist = $page if $needcmdlist; 
  344.  
  345.         $prototype = ''; $seenpage = 0;
  346.  
  347.         foreach $cmd (split(/\s*,\s*/,$ocmdlist)) {
  348.         next unless $cmd;
  349.         $seenpage |= ($cmd eq $page);
  350.         if (! $prototype) {
  351.             &store_direct($cmd, $cmdlist, $tmpfile, $dirext, $desc);
  352.             $prototype = $cmd;
  353.         } else {
  354.             &store_indirect($cmd, "$prototype.$filext");
  355.         } 
  356.         } 
  357.         unless ($seenpage) {
  358.         print "$FILE: forgot my own name!\n" if $debug;
  359.         if ($prototype) {
  360.             &store_indirect($page, "$prototype.$filext");
  361.         } else {
  362.             &store_direct($page, $page, $FILE, $dirext, '');
  363.             #&store_direct($page, $page, $FILE, $dirext, $desc);
  364.         }
  365.         }
  366.     }
  367.     }  
  368.     unless ($foundname) {
  369.     print STDERR "$FILE: no NAME lines, so has no whatis description!\n";
  370.     ($tmpfile = $FILE) =~ s/\.Z$//;
  371.     ($page, $section) = $tmpfile =~ /^(\S+)\.(\S+)$/;
  372.     &store_direct($page, $page, $tmpfile, $dirext, 'NO DESCRIPTION');
  373.     } 
  374. }
  375.  
  376. # --------------------------------------------------------------------------
  377. sub source {
  378.     local($file) = @_;
  379.     local($return) = 0;
  380.  
  381.  
  382.     $return = do $file;
  383.     die  "couldn't parse \"$file\": $@" if $@;
  384.     die  "couldn't do \"$file\": $!" unless defined $return;
  385.     warn "couldn't run \"$file\"" unless $return;
  386. }
  387.  
  388.  
  389. sub chopext {
  390.     $_[0] =~ s/\.Z$//;
  391.     $_[0] =~ s/\.[^.]+$//;
  392. } 
  393.  
  394. sub check_sos {
  395.     local($key);
  396.  
  397.     foreach $key (keys %so) {
  398.     unless (defined $WHATIS{$key}) {
  399.         printf STDERR 
  400.         "%s was a .so alias for %s, but %s's NAME section doesn't know it!\n",
  401.         $key, $so{$key}, $so{$key};
  402.         &store_indirect($key, $so{$key});
  403.     } 
  404.     } 
  405. } 
  406.  
  407. sub store_direct {
  408.     local($cmd, $list, $page, $section, $desc) = @_;
  409.     local($datum);
  410.  
  411.     push(@WHATIS,sprintf("%-20s - %s", "$list ($filext)", $desc));
  412.  
  413.     $datum = join("\001", $list, $page, $section, $desc);
  414.  
  415.     if (defined $WHATIS{$cmd}) {
  416.     if (length($WHATIS{$cmd}) + length($datum) + 1 > $MAXDATUM) {
  417.         print STDERR "can't store $page -- would break DBM\n";
  418.         return;
  419.     } 
  420.     $WHATIS{$cmd} .= "\002";
  421.     } 
  422.  
  423.     print "storing $cmd\n" if $debug;
  424.     $WHATIS{$cmd} .= $datum;
  425.     $entries++;
  426. } 
  427.  
  428. sub store_indirect {
  429.     local($indirect, $real) = @_;
  430.  
  431.     print "storing $indirect as reference to $real\n"
  432.     if $debug;
  433.  
  434.     $WHATIS{$indirect} .= "\002" if $WHATIS{$indirect};
  435.     $WHATIS{$indirect} .= $real;
  436.     $entries++;
  437. } 
  438.  
  439. sub doTH {
  440.     local($THname, $THext) = @_;
  441.     local($int_name, $ext_name);
  442.  
  443.     ($int_name = "$THname.$THext") =~ tr/A-Z/a-z/;
  444.     ($ext_name = "$filenam.$filext") =~ tr/A-Z/a-z/;
  445.  
  446.     if ($int_name ne $ext_name && $debug) {
  447.     print STDERR "${FILE}'s .TH thinks it's in $int_name\n";
  448.     } 
  449. } 
  450.