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: src/gnu/usr.bin/man/makewhatis/makewhatis.perl,v 1.21.2.4 2002/03/29 15:38:09 ru Exp $
  30
  31
  32 sub usage {
  33
  34     warn <<EOF;
  35 usage: makewhatis [-a|-append] [-h|-help] [-i|-indent column] [-L|-locale]
  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     # Array of all entries
  57     @a = ();
  58
  59     # Append mode
  60     if ($append) {
  61         local($file) = $whatisdb;
  62         $file =~ s/\.tmp$// if !$outfile;
  63
  64         if (open(A, "$file")) {
  65             warn "Open $file for append mode\n" if $verbose;
  66             while(<A>) {
  67                 push(@a, $_);
  68             }
  69             close A;
  70         }
  71
  72         else {
  73             warn "$whatisdb: $!\n" if lstat($file) && $verbose; #
  74         }
  75         undef $file;
  76     }
  77
  78
  79     warn "Open $whatisdb\n" if $verbose;
  80     if (!open(A, "> $whatisdb")) {
  81         die "$whatisdb: $!\n" if $outfile;
  82
  83         warn "$whatisdb: $!\n"; $err++; return 0;
  84     }
  85
  86     select A;
  87     return 1;
  88 }
  89
  90 sub close_output {
  91     local($success) = @_;
  92     local($w) = $whatisdb;
  93     local($counter) = 0;
  94     local($i, $last,@b);
  95
  96     $w =~ s/\.tmp$//;
  97     if ($success) {             # success
  98         # uniq
  99         warn "\n" if $verbose && $pointflag;
 100         warn "sort -u > $whatisdb\n" if $verbose;
 101         foreach $i (sort @a) {
 102             if ($i ne $last) {
 103                 push(@b, $i);
 104             }
 105             $last =$i;
 106         }
 107
 108         $counter = $#b + 1;
 109         print @b; close A; select STDOUT;
 110
 111         if (!$outfile) {
 112             warn "Rename $whatisdb to $w\n" if $verbose;
 113             rename($whatisdb, $w) || warn "rename $whatisdb $w\n";
 114             $counter_all += $counter;
 115             warn "$counter entries in $w\n" if $verbose;
 116         } else {
 117             $counter_all = $counter;
 118         }
 119     } else {            # building whatisdb failed
 120         unlink($whatisdb);
 121         warn "building whatisdb: $whatisdb failed\n" if $verbose;
 122     }
 123     return 1;
 124 }
 125
 126 sub parse_subdir {
 127     local($dir) = @_;
 128     local($file, $dev,$ino);
 129
 130     warn "\n" if $pointflag;
 131     warn "traverse $dir\n" if $verbose;
 132     $pointflag = 0;
 133
 134     if (!opendir(M, $dir)) {
 135         warn "$dir: $!\n"; $err++; return 0;
 136     }
 137
 138     $| = 1 if $verbose;
 139     foreach $file (readdir(M)) {
 140         next if $file =~ /^(\.|\.\.)$/;
 141
 142         ($dev, $ino) = ((stat("$dir/$file"))[01]);
 143         if (-f _) {
 144             if ($man_red{"$dev.$ino"}) {
 145                 # Link
 146                 print STDERR "+" if $verbose;
 147                 $pointflag++ if $verbose;
 148             } else {
 149                 &manual("$dir/$file");
 150             }
 151             $man_red{"$dev.$ino"} = 1;
 152         } elsif (! -d _) {
 153             warn "Cannot find file: $dir/$file\n"; $err++;
 154         }
 155     }
 156     closedir M;
 157     return 1;
 158 }
 159
 160 # read man directory
 161 sub parse_dir {
 162     local($dir) = @_;
 163     local($subdir, $file);
 164
 165     # clean up, in case mandir and subdirs are called simultaneously
 166     # e. g.:  ~/man/man1 ~/man/man2 ~/man
 167     #~/man/ man1 and ~/man/man2 are a subset of ~/man
 168     foreach $file (keys %man_red) {
 169         delete $man_red{$file};
 170     }
 171
 172     if ($dir =~ /man/) {
 173         warn "\n" if $verbose && $pointflag;
 174         warn "open manpath directory ``$dir''\n" if $verbose;
 175         $pointflag = 0;
 176         if (!opendir(DIR, $dir)) {
 177             warn "opendir ``$dir'':$!\n"; $err = 1; return 0;
 178         }
 179         foreach $subdir (sort(readdir(DIR))) {
 180             if ($subdir =~ /^man\w+$/) {
 181                 $subdir = "$dir/$subdir";
 182                 &parse_subdir($subdir);
 183                 &parse_subdir($subdir) if -d ($subdir .= "/${machine}");
 184             }
 185         }
 186         closedir DIR
 187
 188     } elsif ($dir =~ /man\w+$/) {
 189         &parse_subdir($dir);
 190     } else {
 191         warn "Assume ``$dir'' is not a man directory.\n";
 192         $err = 1; return 0;
 193     }
 194     return 1;
 195 }
 196
 197 sub dir_redundant {
 198     local($dir) = @_;
 199
 200     local($dev,$ino) = (stat($dir))[0..1];
 201
 202     if ($dir_redundant{"$dev.$ino"}) {
 203         warn "$dir is equal to: $dir_redundant{\"$dev.$ino\"}\n" if $verbose;
 204         return 0;
 205     }
 206     $dir_redundant{"$dev.$ino"} = $dir;
 207     return 1;
 208 }
 209
 210
 211 # ``/usr/man/man1/foo.l'' -> ``l''
 212 sub ext {
 213     local($filename) = @_;
 214     local($extension) = $filename;
 215
 216     $extension =~ s/$ext$//g;   # strip .gz
 217     $extension =~ s/.*\///g;    # basename
 218
 219     if ($extension !~ m%[^/]+\.[^.]+$%) {       # no dot
 220         $extension = $filename;
 221         #$extension =~ s|/[^/]+$||;
 222         $extension =~ s%.*man([^/]+)/[^/]+%$1%; # last character
 223         warn "\n" if $verbose && $pointflag;
 224         warn "$filename has no extension, try section ``$extension''\n"
 225             if $verbose;
 226         $pointflag = 0;
 227     } else {
 228         $extension =~ s/.*\.//g; # foo.bla.1 -> 1
 229     }
 230     return "$extension";
 231 }
 232
 233 # ``/usr/man/man1/foo.1'' -> ``foo''
 234 sub name {
 235     local($name) = @_;
 236
 237     $name =~ s=.*/==;
 238     $name =~ s=$ext$==o;
 239     $name =~ s=\.[^\.]+$==;
 240
 241     return "$name";
 242 }
 243
 244 # output
 245 sub out {
 246     local($list) = @_;
 247     local($delim) = " - ";
 248     $_ = $list;
 249
 250     # delete italic etc.
 251     s/^\.[^ -]+[ -]+//;
 252     s/\\\((em|mi)//;
 253     s/\\f[IRBP]//g;
 254     s/\\\*p//g;
 255     s/\(OBSOLETED\)[ ]?//;
 256     s/\\&//g;
 257     s/^\@INDOT\@//;
 258     s/[\"\\]//g;                #"
 259     s/[. \t-]+$//;
 260
 261     s/ / - / unless / - /;
 262     ($man,$desc) = split(/ - /);
 263
 264     $man = $name unless $man;
 265     $man =~ s/[,. ]+$//;
 266     $man =~ s/,/($extension),/g;
 267     $man .= "($extension)";
 268
 269     &manpagename;
 270
 271     $desc =~ s/^[ \t]+//;
 272
 273     for($i = length($man); $i < $indent && $desc; $i++) {
 274         $man .= ' ';
 275     }
 276     if ($desc) {
 277         push(@a, "$man$delim$desc\n");
 278     } else {
 279         push(@a, "$man\n");
 280     }
 281 }
 282
 283 # The filename of manual page is not a keyword.
 284 # This is bad, because you don't find the manpage
 285 # whith: $ man <section> <keyword>
 286 #
 287 # Add filename if a) filename is not a keyword and b) no keyword(s)
 288 # exist as file in same mansection
 289 #
 290 sub manpagename {
 291     foreach (split(/,\s+/, $man)) {
 292         s/\(.+//;
 293         # filename is keyword
 294         return if $name eq $_;
 295     }
 296
 297     local($f) = $file;  $f =~ s%/*[^/]+$%%;             # dirname
 298     local($e) = $file;  $e =~ s/$ext$//;  $e =~ s%.*(\.[^.]+)$%$1%; # .1
 299
 300     foreach (split(/,\s+/, $man)) {
 301         s/\(.+//;
 302
 303         # a keyword exist as file
 304         return if -e "$f/$_$e" || -e "$f/$_$e$ext";
 305     }
 306
 307     $man = "$name($extension), $man";
 308 }
 309
 310 # looking for NAME
 311 sub manual {
 312     local($file) = @_;
 313     local($list, $desc, $extension);
 314     local($ofile) = $file;
 315
 316     # Compressed man pages
 317     if ($ofile =~ /$ext$/) {
 318         $ofile = "gzcat $file |";
 319         print STDERR "*" if $verbose;
 320     } else {
 321         print STDERR "." if $verbose;
 322     }
 323     $pointflag++ if $verbose;
 324
 325     if (!open(F, "$ofile")) {
 326         warn "Cannot open file: $ofile\n"; $err++;
 327         return 0;
 328     }
 329     # extension/section
 330     $extension = &ext($file);
 331     $name = &name($file);
 332
 333     $section_name = "NAME|Name|NAMN|BEZEICHNUNG|Ì¾¾Î|îáú÷áîéå";
 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]+["]?($section_name)["]?/) {
 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             while(<F>) { }      # skip remaining input to avoid pipe errors
 357             &out($list); close F; return 1;
 358         } elsif (/^\.Sh/ && /^\.Sh[ \t]+["]?($section_name)["]?/) {
 359             # ``doc'' style pages
 360             local($flag) = 0;
 361             while(<F>) {
 362                 last if /^\.Sh/;
 363                 chop;
 364                 s/^\.\\".*$//;            #" delete comments
 365                 next if /^\.[ \t]*$/;     # skip empty calls
 366                 if (/^\.Nm/) {
 367                     s/^\.Nm[ \t]*//;
 368                     s/ ,/,/g;
 369                     s/[ \t]+$//;
 370                     $list .= $_;
 371                     $list .= ' ';
 372                 } else {
 373                     $list .= '- ' if (!$flag && !/^- /);
 374                     $flag++;
 375                     if (/^\.Xr/) {
 376                         split;
 377                         $list .= @_[1];
 378                         $list .= "(@_[2])" if @_[2];
 379                     } else {
 380                         s/^\.([A-Z][a-z])?[ \t]*//;
 381                         s/[ \t]+$//;
 382                         $list .= $_;
 383                     }
 384                     $list .= ' ';
 385                 }
 386             }
 387             while(<F>) { }      # skip remaining input to avoid pipe errors
 388             &out($list); close F; return 1;
 389
 390         } elsif(/^\.so/ && /^\.so[ \t]+man/) {
 391             while(<F>) { }      # skip remaining input to avoid pipe errors
 392             close F; return 1;
 393         }
 394     }
 395     if (!$source && $verbose) {
 396         warn "\n" if $pointflag;
 397         warn "Maybe $file is not a manpage\n" ;
 398         $pointflag = 0;
 399     }
 400     return 0;
 401 }
 402
 403 # make relative path to absolute path
 404 sub absolute_path {
 405     local(@dirlist) = @_;
 406     local($pwd, $dir, @a);
 407
 408     $pwd = $ENV{'PWD'};
 409     foreach $dir (@dirlist) {
 410         if ($dir !~ "^/") {
 411             chop($pwd = `pwd`) if (!$pwd || $pwd !~ /^\//);
 412             push(@a, "$pwd/$dir");
 413         } else {
 414             push(@a, $dir);
 415         }
 416     }
 417     return @a;
 418 }
 419
 420 # strip unused '/'
 421 # e.g.: //usr///home// -> /usr/home
 422 sub stripdir {
 423     local($dir) = @_;
 424
 425     $dir =~ s|/+|/|g;           # delete double '/'
 426     $dir =~ s|/$||;             # delete '/' at end
 427     $dir =~ s|/(\.\/)+|/|g;     # delete ././././
 428
 429     $dir =~ s|/+|/|g;           # delete double '/'
 430     $dir =~ s|/$||;             # delete '/' at end
 431     $dir =~ s|/\.$||;           # delete /. at end
 432     return $dir if $dir ne "";
 433     return '/';
 434 }
 435
 436 sub variables {
 437     $verbose = 0;               # Verbose
 438     $indent = 24;               # Indent for description
 439     $outfile = 0;               # Don't write to ./whatis
 440     $whatis_name = "whatis";    # Default name for DB
 441     $append = 0;                # Don't delete old entries
 442     $locale = 0;                # Build DB only for localized man directories
 443     chomp($machine = $ENV{'MACHINE'} || `uname -m`);
 444
 445     # choose localized man directories suffix.
 446     $local_suffix = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'};
 447
 448     # if no argument for directories given
 449     @defaultmanpath = ( '/usr/share/man' );
 450
 451     $ext = '.gz';               # extension
 452     umask(022);
 453
 454     $err = 0;                   # exit code
 455     $whatisdb = '';
 456     $counter_all = 0;
 457     $dir_redundant = '';        # redundant directories
 458     $man_red = '';              # redundant man pages
 459     @a = ();                    # Array for output
 460
 461     # Signals
 462     $SIG{'INT'} = 'Exit';
 463     $SIG{'HUP'} = 'Exit';
 464     $SIG{'TRAP'} = 'Exit';
 465     $SIG{'QUIT'} = 'Exit';
 466     $SIG{'TERM'} = 'Exit';
 467     $tmp = '';                  # tmp file
 468
 469     $ENV{'PATH'} = "/bin:/usr/bin:$ENV{'PATH'}";
 470 }
 471
 472 sub  Exit {
 473     unlink($tmp) if $tmp ne ""; # unlink if a filename
 474     die "$0: die on signal SIG@_\n";
 475 }
 476
 477 sub parse {
 478     local(@argv) = @_;
 479     local($i);
 480
 481     while ($_ = $argv[0], /^-/) {
 482         shift @argv;
 483         last if /^--$/;
 484         if    (/^--?(v|verbose)$/)      { $verbose = 1 }
 485         elsif (/^--?(h|help|\?)$/)      { &usage }
 486         elsif (/^--?(o|outfile)$/)      { $outfile = $argv[0]; shift @argv }
 487         elsif (/^--?(f|format|i|indent)$/) { $i = $argv[0]; shift @argv }
 488         elsif (/^--?(n|name)$/)         { $whatis_name = $argv[0];shift @argv }
 489         elsif (/^--?(a|append)$/)       { $append = 1 }
 490         elsif (/^--?(L|locale)$/)       { $locale = 1 }
 491         else                            { &usage }
 492     }
 493     warn "Localized man directory suffix is ``$local_suffix''\n"
 494         if $verbose && $locale;
 495
 496     if ($i ne "") {
 497         if ($i =~ /^[0-9]+$/) {
 498             $indent = $i;
 499         } else {
 500             warn "Ignoring wrong indent value: ``$i''\n";
 501         }
 502     }
 503
 504     return &absolute_path(@argv) if $#argv >= 0;
 505     return @defaultmanpath if $#defaultmanpath >= 0;
 506
 507     warn "Missing directories\n"; &usage;
 508 }
 509
 510 # Process man directory
 511 sub process_dir {
 512   local($dir) = @_;
 513
 514   $dir = &stripdir($dir);
 515   &dir_redundant($dir) && &parse_dir($dir);
 516 }
 517
 518 # Process man directory and store output to file
 519 sub process_dir_to_file {
 520   local($dir) = @_;
 521
 522   $dir = &stripdir($dir);
 523   &dir_redundant($dir) &&
 524       &close_output(&open_output($dir) && &parse_dir($dir));
 525 }
 526
 527 # convert locale name to short notation (ru_RU.KOI8-R -> ru.KOI8-R)
 528 sub short_locale_name {
 529   local($lname) = @_;
 530
 531   $lname =~ s|_[A-Z][A-Z]||;
 532   warn "short locale name is $lname\n" if $verbose && $locale;
 533   return $lname;
 534 }
 535
 536 ##
 537 ## Main
 538 ##
 539
 540 &variables;
 541 # allow colons in dir: ``makewhatis dir1:dir2:dir3''
 542 @argv = &parse(split(/[: ]/, join($", @ARGV))); # "
 543
 544 if ($outfile) {
 545     if(&open_output($outfile)){
 546         foreach $dir (@argv) {
 547             # "Local only" flag set ? Yes ...
 548             if ($locale) {
 549                 if ($local_suffix ne "") {
 550                      &process_dir($dir.'/'.$local_suffix);
 551                      &process_dir($dir.'/'.&short_locale_name($local_suffix));
 552                 }
 553             } else {
 554                 &process_dir($dir);
 555             }
 556         }
 557     }
 558     &close_output(1);
 559 } else {
 560     foreach $dir (@argv) {
 561         # "Local only" flag set ? Yes ...
 562         if ($locale) {
 563             if ($local_suffix ne "") {
 564               &process_dir_to_file($dir.'/'.$local_suffix);
 565               &process_dir_to_file($dir.'/'.&short_locale_name($local_suffix));
 566             }
 567         } else {
 568            &process_dir_to_file($dir);
 569         }
 570     }
 571 }
 572
 573 warn "Total entries: $counter_all\n" if $verbose && ($#argv > 0 || $outfile);
 574 exit $err;