gnu/usr.bin/man/makewhatis/makewhatis.perl

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