home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-bin / bin / makewhatis.pl < prev    next >
Encoding:
Perl Script  |  1996-10-14  |  12.2 KB  |  525 lines
  1. #!/ade/bin/perl
  2. #
  3. # Copyright (c) 1994, 1995 Wolfram Schneider. All rights reserved.
  4. # Alle Rechte vorbehalten. Es gilt das kontinentaleuropäische Urheberrecht.
  5. #
  6. # Redistribution and use in source and binary forms, with or without
  7. # modification, are permitted provided that the following conditions
  8. # are met:
  9. # 1. Redistributions of source code must retain the above copyright
  10. #    notice, this list of conditions and the following disclaimer.
  11. # 2. Redistributions in binary form must reproduce the above copyright
  12. #    notice, this list of conditions and the following disclaimer in the
  13. #    documentation and/or other materials provided with the distribution.
  14. # 3. All advertising materials mentioning features or use of this software
  15. #    must display the following acknowledgement:
  16. #    This product includes software developed by Wolfram Schneider
  17. # 4. The name of the author may not be used to endorse or promote products
  18. #    derived from this software without specific prior written permission
  19. #
  20. # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  21. # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  22. # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  23. # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  24. # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31. #
  32. #
  33. # makewhatis -- update the whatis database in the man directories.
  34. #
  35. # $Id: makewhatis.perl,v 1.6.4.3 1996/06/23 20:30:05 wosch Exp $
  36.  
  37.  
  38. sub usage {
  39.  
  40.     warn <<EOF;
  41. usage: makewhatis [-a|-append ] [-h|-help] [-i|-indent colum]
  42.           [-n|-name name] [-o|-outfile file] [-v|-verbose]
  43.           [directories ...]
  44. EOF
  45.     exit 1;
  46. }
  47.  
  48.  
  49. # Format output
  50. sub open_output {
  51.     local($dir) = @_;
  52.  
  53.     die "Name for whatis is empty\n" if $whatis_name eq "";
  54.  
  55.     if ($outfile) {             # Write all Output to $outfile
  56.     $whatisdb = $outfile;
  57.     } else {        # Use man/whatis
  58.     $whatisdb = $dir . "/$whatis_name.tmp";
  59.     }
  60.     $tmp = $whatisdb;        # for signals
  61.  
  62.  
  63.     # Array of all entries
  64.     @a = ();
  65.  
  66.  
  67.     # Append mode
  68.     if ($append) {
  69.     local($file) = $whatisdb;
  70.     $file =~ s/\.tmp$// if !$outfile;
  71.  
  72.     if (open(A, "$file")) {
  73.         warn "Open $file for append mode\n" if $verbose;
  74.         while(<A>) {
  75.         push(@a, $_);
  76.         }
  77.         close A;
  78.     }
  79.  
  80.     else {
  81.         warn "$whatisdb: $!\n" if lstat($file) && $verbose; #
  82.     }
  83.     undef $file;
  84.     }
  85.  
  86.  
  87.     warn "Open $whatisdb\n" if $verbose;
  88.     if (!open(A, "> $whatisdb")) {
  89.     die "$whatisdb: $!\n" if $outfile;
  90.  
  91.     warn "$whatisdb: $!\n"; $err++; return 0;
  92.     }
  93.  
  94.     select A;
  95.     return 1;
  96. }
  97.  
  98. sub close_output {
  99.     local($success) = @_;
  100.     local($w) = $whatisdb;
  101.     local($counter) = 0;
  102.     local($i, $last,@b);
  103.  
  104.     $w =~ s/\.tmp$//;
  105.     if ($success) {             # success
  106.  
  107.     # uniq
  108.     warn "\n" if $verbose && $pointflag;
  109.     warn "sort -u > $whatisdb\n" if $verbose;
  110.     foreach $i (sort @a) {
  111.         if ($i ne $last) {
  112.         push(@b, $i);
  113.         }
  114.         $last =$i;
  115.     }
  116.  
  117.     $counter = $#b + 1;
  118.     print @b; close A; select STDOUT;
  119.  
  120.     if (!$outfile) {
  121.         warn "Rename $whatisdb to $w\n" if $verbose;
  122.         rename($whatisdb, $w) || warn "rename $whatisdb $w\n";
  123.         $counter_all += $counter;
  124.         warn "$counter entries in $w\n" if $verbose;
  125.     } else {
  126.         $counter_all = $counter;
  127.     }
  128.     } else {        # building whatisdb failed
  129.     unlink($whatisdb);
  130.     warn "building whatisdb: $whatisdb failed\n" if $verbose;
  131.     }
  132.     return 1;
  133. }
  134.  
  135. sub parse_subdir {
  136.     local($dir) = @_;
  137.     local($file, $dev,$ino);
  138.  
  139.     warn "\n" if $pointflag;
  140.     warn "traverse $dir\n" if $verbose;
  141.     $pointflag = 0;
  142.  
  143.     if (!opendir(M, $dir)) {
  144.     warn "$dir: $!\n"; $err++; return 0;
  145.     }
  146.  
  147.     $| = 1 if $verbose;
  148.     foreach $file (readdir(M)) {
  149.     next if $file =~ /^(\.|\.\.)$/;
  150.  
  151.     ($dev, $ino) = ((stat("$dir/$file"))[01]);
  152.     if (-f _) {
  153.         if ($man_red{"$dev.$ino"}) {
  154.         # Link
  155.         print STDERR "+" if $verbose;
  156.         $pointflag++ if $verbose;
  157.         } else {
  158.         &manual("$dir/$file");
  159.         }
  160.         $man_red{"$dev.$ino"} = 1;
  161.     } elsif (! -d _) {
  162.         warn "Cannot find file: $dir/$file\n"; $err++;
  163.     }
  164.     }
  165.     closedir M;
  166.     return 1;
  167. }
  168.  
  169. # read man directory
  170. sub parse_dir {
  171.     local($dir) = @_;
  172.     local($subdir, $file);
  173.  
  174.     # clean up, in case mandir and subdirs are called simultaneously
  175.     # e. g.:  ~/man/man1 ~/man/man2 ~/man
  176.     #~/man/ man1 and ~/man/man2 are a subset of ~/man
  177.     foreach $file (keys %man_red) {
  178.     delete $man_red{$file};
  179.     }
  180.  
  181.     if ($dir =~ /man$/) {
  182.     warn "\n" if $verbose && $pointflag;
  183.     warn "open manpath directory ``$dir''\n" if $verbose;
  184.     $pointflag = 0;
  185.     if (!opendir(DIR, $dir)) {
  186.         warn "opendir ``$dir'':$!\n"; $err = 1; return 0;
  187.     }
  188.     foreach $subdir (sort(readdir(DIR))) {
  189.         if ($subdir =~ /^man\w+$/) {
  190.         $subdir = "$dir/$subdir";
  191.         &parse_subdir($subdir);
  192.         }
  193.     }
  194.     closedir DIR
  195.  
  196.     } elsif ($dir =~ /man\w+$/) {
  197.     &parse_subdir($dir);
  198.     } else {
  199.     warn "Assume ``$dir'' is not a man directory.\n";
  200.     $err = 1; return 0;
  201.     }
  202.     return 1;
  203. }
  204.  
  205. sub dir_redundant {
  206.     local($dir) = @_;
  207.  
  208.     local ($dev,$ino) = (stat($dir))[0..1];
  209.  
  210.     if ($dir_redundant{"$dev.$ino"}) {
  211.     warn "$dir is equal to: $dir_redundant{\"$dev.$ino\"}\n" if $verbose;
  212.     return 0;
  213.     }
  214.     $dir_redundant{"$dev.$ino"} = $dir;
  215.     return 1;
  216. }
  217.  
  218.  
  219. # ``/usr/man/man1/foo.l'' -> ``l''
  220. sub ext {
  221.     local($filename) = @_;
  222.     local($extension) = $filename;
  223.  
  224.     $extension =~ s/$ext$//g;    # strip .gz
  225.     $extension =~ s/.*\///g;    # basename
  226.  
  227.     if ($extension !~ /\./) {   # no dot
  228.     $extension = $filename;
  229.     #$extension =~ s|/[^/]+$||;
  230.     $extension =~ s/.*(.)/$1/; # last character
  231.     warn "\n" if $verbose && $pointflag;
  232.     warn "$filename has no extension, try section ``$extension''\n"
  233.         if $verbose;
  234.     $pointflag = 0;
  235.     } else {
  236.     $extension =~ s/.*\.//g; # foo.bla.1 -> 1
  237.     }
  238.     return "$extension";
  239. }
  240.  
  241. # ``/usr/man/man1/foo.1'' -> ``foo''
  242. sub name {
  243.     local($name) = @_;
  244.  
  245.     $name =~ s=.*/==;
  246.     $name =~ s=$ext$==o;
  247.     $name =~ s=\.[^\.]+$==;
  248.  
  249.     return "$name";
  250. }
  251.  
  252. # output
  253. sub out {
  254.     local($list) = @_;
  255.     local($delim) = " - ";
  256.     $_ = $list;
  257.  
  258.     # delete italic etc.
  259.     s/^\.[^ -]+[ -]+//;
  260.     s/\\\((em|mi)//;
  261.     s/\\f[IRBP]//g;
  262.     s/\\\*p//g;
  263.     s/\(OBSOLETED\)[ ]?//;
  264.     s/\\&//g;
  265.     s/^\@INDOT\@//;
  266.     s/[\"\\]//g;                #"
  267.     s/[. \t-]+$//;
  268.  
  269.     s/ / - / unless / - /;
  270.     ($man,$desc) = split(/ - /);
  271.  
  272.     $man = $name unless $man;
  273.     $man =~ s/[,. ]+$//;
  274.     $man =~ s/,/($extension),/g;
  275.     $man .= "($extension)";
  276.  
  277.     &manpagename;
  278.  
  279.     $desc =~ s/^[ \t]+//;
  280.  
  281.     for($i = length($man); $i < $indent && $desc; $i++) {
  282.     $man .= ' ';
  283.     }
  284.     if ($desc) {
  285.     push(@a, "$man$delim$desc\n");
  286.     } else {
  287.     push(@a, "$man\n");
  288.     }
  289. }
  290.  
  291. # The filename of manual page is not a keyword.
  292. # This is bad, because you don't find the manpage
  293. # whith: $ man <section> <keyword>
  294. #
  295. # Add filename if a) filename is not a keyword and b) no keyword(s)
  296. # exist as file in same mansection
  297. #
  298. sub manpagename {
  299.     foreach (split(/,\s+/, $man)) {
  300.     s/\(.+//;
  301.     # filename is keyword
  302.     return if $name eq $_;
  303.     }
  304.  
  305.     local($f) = $file;  $f =~ s%/*[^/]+$%%;             # dirname
  306.     local($e) = $file;  $e =~ s/$ext$//;  $e =~ s%.*(\.[^.]+)$%$1%; # .1
  307.  
  308.     foreach (split(/,\s+/, $man)) {
  309.     s/\(.+//;
  310.  
  311.     # a keyword exist as file
  312.     return if -e "$f/$_$e" || -e "$f/$_$e$ext";
  313.     }
  314.  
  315.     $man = "$name($extension), $man";
  316. }
  317.  
  318. # looking for NAME
  319. sub manual {
  320.     local($file) = @_;
  321.     local($list, $desc, $extension);
  322.     local($ofile) = $file;
  323.  
  324.     # Compressed man pages
  325.     if ($ofile =~ /$ext$/) {
  326.     $ofile = "gzcat $file |";
  327.     print STDERR "*" if $verbose;
  328.     } else {
  329.     print STDERR "." if $verbose;
  330.     }
  331.     $pointflag++ if $verbose;
  332.  
  333.     if (!open(F, "$ofile")) {
  334.     warn "Cannot open file: $ofile\n"; $err++;
  335.     return 0;
  336.     }
  337.     # extension/section
  338.     $extension = &ext($file);
  339.     $name = &name($file);
  340.  
  341.     local($source) = 0;
  342.     local($list);
  343.     while(<F>) {
  344.     # ``man'' style pages
  345.     # &&: it takes you only half the user time, regexp is slow!!!
  346.     if (/^\.SH/ && /^\.SH[ \t]+["]?(NAME|Name|NAMN)["]?/) {
  347.         #while(<F>) { last unless /^\./ } # Skip
  348.         #chop; $list = $_;
  349.         while(<F>) {
  350.         last if /^\.SH[ \t]/;
  351.         chop;
  352.         s/^\.[A-Z]+[ ]+[0-9]+$//; # delete commands
  353.         s/^\.[A-Za-z]+[ \t]*//;   # delete commands
  354.         s/^\.\\".*$//;            #" delete comments
  355.         s/^[ \t]+//;
  356.         if ($_) {
  357.             $list .= $_;
  358.             $list .= ' ';
  359.         }
  360.         }
  361.         &out($list); close F; return 1;
  362.     } elsif (/^\.Sh/ && /^\.Sh[ \t]+["]?(NAME|Name)["]?/) {
  363.         # ``doc'' style pages
  364.         local($flag) = 0;
  365.         while(<F>) {
  366.         last if /^\.Sh/;
  367.         chop;
  368.         s/^\.\\".*$//;            #" delete comments
  369.         if (/^\.Nm/) {
  370.             s/^\.Nm[ \t]*//;
  371.             s/ ,/,/g;
  372.             s/[ \t]+$//;
  373.             $list .= $_;
  374.             $list .= ' ';
  375.         } else {
  376.             $list .= '- ' if (!$flag && !/-/);
  377.             $flag++;
  378.             s/^\.[A-Z][a-z][ \t]*//;
  379.             s/[ \t]+$//;
  380.             $list .= $_;
  381.             $list .= ' ';
  382.         }
  383.         }
  384.         &out($list); close F; return 1;
  385.  
  386.     } elsif(/^\.so/ && /^\.so[ \t]+man/) {
  387.         close F; return 1;
  388.     }
  389.     }
  390.     if (!$source && $verbose) {
  391.     warn "\n" if $pointflag;
  392.     warn "Maybe $file is not a manpage\n" ;
  393.     $pointflag = 0;
  394.     }
  395.     return 0;
  396. }
  397.  
  398. # make relative path to absolute path
  399. sub absolute_path {
  400.     local(@dirlist) = @_;
  401.     local($pwd, $dir, @a);
  402.  
  403.     $pwd = $ENV{'PWD'};
  404.     foreach $dir (@dirlist) {
  405.     if ($dir !~ "^/") {
  406.         chop($pwd = `pwd`) if (!$pwd || $pwd !~ /^\//);
  407.         push(@a, "$pwd/$dir");
  408.     } else {
  409.         push(@a, $dir);
  410.     }
  411.     }
  412.     return @a;
  413. }
  414.  
  415. # strip unused '/'
  416. # e.g.: //usr///home// -> /usr/home
  417. sub stripdir {
  418.     local($dir) = @_;
  419.  
  420.     $dir =~ s|/+|/|g;        # delete double '/'
  421.     $dir =~ s|/$||;        # delete '/' at end
  422.     $dir =~ s|/(\.\/)+|/|g;     # delete ././././
  423.  
  424.     $dir =~ s|/+|/|g;        # delete double '/'
  425.     $dir =~ s|/$||;        # delete '/' at end
  426.     $dir =~ s|/\.$||;        # delete /. at end
  427.     return $dir if $dir ne "";
  428.     return '/';
  429. }
  430.  
  431. sub variables {
  432.     $verbose = 0;        # Verbose
  433.     $indent = 24;        # indent for description
  434.     $outfile = 0;        # Don't write to ./whatis
  435.     $whatis_name = "whatis";    # Default name for DB
  436.     $append = 0;        # Don't delete old entries
  437.  
  438.     # if no argument for directories given
  439.     @defaultmanpath = ( '/usr/share/man' );
  440.  
  441.     $ext = '.gz';               # extension
  442.     umask(022);
  443.  
  444.     $err = 0;            # exit code
  445.     $whatisdb = '';
  446.     $counter_all = 0;
  447.     $dir_redundant = '';        # redundant directories
  448.     $man_red = '';              # redundant man pages
  449.     @a = ();                    # Array for output
  450.  
  451.     # Signals
  452.     $SIG{'INT'} = 'Exit';
  453.     $SIG{'HUP'} = 'Exit';
  454.     $SIG{'TRAP'} = 'Exit';
  455.     $SIG{'QUIT'} = 'Exit';
  456.     $SIG{'TERM'} = 'Exit';
  457.     $tmp = '';                  # tmp file
  458.  
  459.     $ENV{'PATH'} = "/bin:/usr/bin:$ENV{'PATH'}";
  460. }
  461.  
  462. sub  Exit {
  463.     unlink($tmp) if $tmp ne ""; # unlink if a filename
  464.     die "$0: die on signal SIG@_\n";
  465. }
  466.  
  467. sub parse {
  468.     local(@argv) = @_;
  469.     local($i);
  470.  
  471.     while ($_ = $argv[0], /^-/) {
  472.     shift @argv;
  473.     last if /^--$/;
  474.     if    (/^--?(v|verbose)$/)      { $verbose = 1 }
  475.     elsif (/^--?(h|help|\?)$/)      { &usage }
  476.     elsif (/^--?(o|outfile)$/)      { $outfile = $argv[0]; shift @argv }
  477.     elsif (/^--?(f|format|i|indent)$/) { $i = $argv[0]; shift @argv }
  478.     elsif (/^--?(n|name)$/)         { $whatis_name = $argv[0];shift @argv }
  479.     elsif (/^--?(a|append)$/)       { $append = 1 }
  480.     else                { &usage }
  481.     }
  482.  
  483.     if ($i ne "") {
  484.     if ($i =~ /^[0-9]+$/) {
  485.         $indent = $i;
  486.     } else {
  487.         warn "Ignoring wrong indent value: ``$i''\n";
  488.     }
  489.     }
  490.  
  491.     return &absolute_path(@argv) if $#argv >= 0;
  492.     return @defaultmanpath if $#defaultmanpath >= 0;
  493.  
  494.     warn "Missing directories\n"; &usage;
  495. }
  496.  
  497.  
  498. ##
  499. ## Main
  500. ##
  501.  
  502. &variables;
  503. # allow colons in dir: ``makewhatis dir1:dir2:dir3''
  504. @argv = &parse(split(/[: ]/, join($", @ARGV))); # "
  505.  
  506.  
  507. if ($outfile) {
  508.     if(&open_output($outfile)){
  509.     foreach $dir (@argv) {
  510.         $dir = &stripdir($dir);
  511.         &dir_redundant($dir) && &parse_dir($dir);
  512.     }
  513.     }
  514.     &close_output(1);
  515. } else {
  516.     foreach $dir (@argv) {
  517.     $dir = &stripdir($dir);
  518.     &dir_redundant($dir) &&
  519.         &close_output(&open_output($dir) && &parse_dir($dir));
  520.     }
  521. }
  522.  
  523. warn "Total entries: $counter_all\n" if $verbose && ($#argv > 0 || $outfile);
  524. exit $err;
  525.