gnu/usr.bin/man/catman/catman.perl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (c) March 1995 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 # /usr/bin/catman - preformat man pages
  28 #
  29 # $FreeBSD: src/gnu/usr.bin/man/catman/catman.perl,v 1.14.2.5 2002/01/05 16:20:52 phantom Exp $
  30
  31
  32 sub usage {
  33
  34 warn <<EOF;
  35 usage: catman [-f|-force] [-h|-help] [-L|-locale] [-p|-print] [-r|remove]
  36               [-v|-verbose] [directories ...]
  37 EOF
  38
  39 exit 1;
  40 }
  41
  42 sub variables {
  43     $force = 0;                 # force overwriting existing catpages
  44     $verbose = 0;               # more warnings
  45     $print = 0;                 # show only, do nothing
  46     $remove = 0;                # unlink forgotten man/catpages
  47     $locale = 0;                # go through localized man directories only
  48
  49     # choose localized man directories suffix.
  50     $local_suffix = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'};
  51
  52     # if no argument for directories given
  53     @defaultmanpath = ( '/usr/share/man' );
  54
  55     $exit = 0;                  # exit code
  56     $ext = ".gz";               # extension
  57     umask(022);
  58
  59     # Signals
  60     $SIG{'INT'} = 'Exit';
  61     $SIG{'HUP'} = 'Exit';
  62     $SIG{'TRAP'} = 'Exit';
  63     $SIG{'QUIT'} = 'Exit';
  64     $SIG{'TERM'} = 'Exit';
  65     $tmp = '';                  # tmp file
  66
  67     $ENV{'PATH'} = '/bin:/usr/bin';
  68 }
  69
  70 sub  Exit {
  71     unlink($tmp) if $tmp ne ""; # unlink if a filename
  72     die "$0: die on signal SIG@_\n";
  73 }
  74
  75 sub parse {
  76     local(@argv) = @_;
  77
  78     while($_ = $argv[0], /^-/) {
  79         shift @argv;
  80         last if /^--$/;
  81         if    (/^--?(f|force)$/)     { $force = 1 }
  82         elsif (/^--?(p|print)$/)     { $print = 1 }
  83         elsif (/^--?(r|remove)$/)    { $remove = 1 }
  84         elsif (/^--?(v|verbose)$/)   { $verbose = 1 }
  85         elsif (/^--?(L|locale)$/)    { $locale = 1 }
  86         else { &usage }
  87     }
  88     warn "Localized man directory suffix is $local_suffix\n"
  89         if $verbose && $locale;
  90
  91     return &absolute_path(@argv) if $#argv >= 0;
  92     return @defaultmanpath if $#defaultmanpath >= 0;
  93
  94     warn "Missing directories\n"; &usage;
  95 }
  96
  97 # make relative path to absolute path
  98 sub absolute_path {
  99     local(@dirlist) = @_;
 100     local($pwd, $dir, @a);
 101
 102     $pwd = $ENV{'PWD'};
 103
 104     foreach $dir (@dirlist) {
 105         if ($dir !~ "^/") {
 106             chop($pwd = `pwd`) if (!$pwd || $pwd !~ /^\//);
 107             push(@a, "$pwd/$dir");
 108         } else {
 109             push(@a, $dir);
 110         }
 111     }
 112     return @a;
 113 }
 114
 115 # strip unused '/'
 116 # e.g.: //usr///home// -> /usr/home
 117 sub stripdir {
 118     local($dir) = @_;
 119
 120     $dir =~ s|/+|/|g;           # delete double '/'
 121     $dir =~ s|/$||;             # delete '/' at end
 122     $dir =~ s|/(\.\/)+|/|g;     # delete ././././
 123
 124     $dir =~ s|/+|/|g;           # delete double '/'
 125     $dir =~ s|/$||;             # delete '/' at end
 126     $dir =~ s|/\.$||;           # delete /. at end
 127     return $dir if $dir ne "";
 128     return '/';
 129 }
 130
 131 # read man directory
 132 sub parse_dir {
 133     local($dir) = @_;
 134     local($subdir, $catdir);
 135     local($dev,$ino) = (stat($dir))[01];
 136
 137     # already visit
 138     if ($dir_visit{$dev,$ino}) {
 139         warn "$dir already parsed: $dir_visit{$dev,$ino}\n";
 140         return 1;
 141     }
 142     $dir_visit{$dev,$ino} = $dir;
 143
 144     # Manpath, /usr/local/man or
 145     # localized manpath /usr/local/man/{$LC_CTYPE|$LANG}
 146     if (($dir =~ /man$/) ||
 147        (($locale) && ($dir =~ /man/) && ($dir =~ $local_suffix))) {
 148         warn "open manpath directory ``$dir''\n" if $verbose;
 149         if (!opendir(DIR, $dir)) {
 150             warn "opendir ``$dir'':$!\n"; $exit = 1; return 0;
 151         }
 152
 153         warn "chdir to: $dir\n" if $verbose;
 154         chdir($dir) || do { warn "$dir: $!\n"; $exit = 1; return 0 };
 155
 156         foreach $subdir (sort(readdir(DIR))) {
 157             if ($subdir =~ /^man\w+$/) {
 158                 $subdir = "$dir/$subdir";
 159                 &catdir_create($subdir) && &parse_subdir($subdir);
 160             }
 161         }
 162         closedir DIR
 163
 164     # subdir, /usr/local/man/man1
 165     } elsif ($dir =~ /man\w+$/) {
 166         local($parentdir) = $dir;
 167         $parentdir =~ s|/[^/]+$||;
 168         warn "chdir to: $parentdir\n" if $verbose;
 169         chdir($parentdir) || do {
 170             warn "$parentdir: $!\n"; $exit = 1; return 0 };
 171
 172         &catdir_create($dir) && &parse_subdir($dir);
 173     } else {
 174         warn "Assume ``$dir'' is not a man directory.\n";
 175         $exit = 1;
 176     }
 177 }
 178
 179 # create cat subdirectory if neccessary
 180 # e.g.: man9 exist, but cat9 not
 181 sub catdir_create {
 182     local($subdir) = @_;
 183     local($catdir) = $subdir;
 184
 185     $catdir = &man2cat($subdir);
 186     if (-d $catdir) {
 187         return 1 if -w _;
 188         if (!chmod(0755, $catdir)) {
 189             warn "Cannot write $catdir, chmod: $!\n";
 190             $exit = 1;
 191             return 0;
 192         }
 193         return 1;
 194     }
 195
 196     warn "mkdir ``$catdir''\n" if $verbose || $print;
 197     unless ($print) {
 198         unlink($catdir);        # be paranoid
 199         if (!mkdir($catdir, 0755)) {
 200             warn "Cannot make $catdir: $!\n";
 201             $exit = 1;
 202             return 0;
 203         }
 204         return 1;
 205     }
 206 }
 207
 208 # I: /usr/share/man/man9
 209 # O: /usr/share/man/cat9
 210 sub man2cat {
 211     local($man) = @_;
 212
 213     $man =~ s/man(\w+)$/cat$1/;
 214     return $man;
 215 }
 216
 217 sub parse_subdir {
 218     local($subdir) = @_;
 219     local($file, $f, $catdir, $catdir_short, $mandir, $mandir_short);
 220     local($mtime_man, $mtime_cat);
 221     local(%read);
 222
 223     $mandir = $subdir;
 224     $catdir = &man2cat($mandir);
 225
 226     ($mandir_short = $mandir) =~ s|.*/(.*)|$1|;
 227     ($catdir_short = $catdir) =~ s|.*/(.*)|$1|;
 228
 229     warn "open man directory: ``$mandir''\n" if $verbose;
 230     if (!opendir(D, $mandir)) {
 231         warn "opendir ``$mandir'': $!\n"; $exit = 1; return 0;
 232     }
 233
 234     foreach $file (readdir(D)) {
 235         # skip current and parent directory
 236         next if $file eq "." || $file eq "..";
 237
 238         # fo_09-o.bar0
 239         if ($file !~ /^[\w\-\+\[\.:]+\.\w+$/) {
 240             &garbage("$mandir/$file", "Assume garbage")
 241                 unless -d "$mandir/$file";
 242             next;
 243         }
 244
 245         if ($file !~ /\.gz$/) {
 246             if (-e "$mandir/$file.gz") {
 247                 &garbage("$mandir/$file",
 248                          "Manpage unused, see compressed version");
 249                 next;
 250             }
 251             warn "$mandir/$file is uncompressed\n" if $verbose;
 252             $cfile = "$file.gz";
 253         } else {
 254             $cfile = "$file";
 255         }
 256
 257         if (!(($mtime_man = ((stat("$mandir_short/$file"))[9])) && -r _ && -f _)) {
 258             if (! -d _) {
 259                 warn "Cannot read file: ``$mandir/$file''\n";
 260                 $exit = 1;
 261                 if ($remove && -l "$mandir/$file") {
 262                     &garbage("$mandir/$file", "Assume wrong symlink");
 263                 }
 264                 next;
 265             }
 266             warn "Ignore subsubdirectory: ``$mandir/$file''\n"
 267                 if $verbose;
 268             next;
 269         }
 270
 271         $read{$file} = 1;
 272
 273         # Assume catpages always compressed
 274         if (($mtime_cat = ((stat("$catdir_short/$cfile"))[9]))
 275             && -r _ && -f _) {
 276             if ($mtime_man > $mtime_cat || $force) {
 277                 &nroff("$mandir/$file", "$catdir/$cfile");
 278             } else {
 279                 warn "up to date: $mandir/$file\n" if $verbose;
 280                 #print STDERR "." if $verbose;
 281             }
 282         } else {
 283             &nroff("$mandir/$file", "$catdir/$cfile");
 284         }
 285     }
 286     closedir D;
 287
 288     if (!opendir(D, $catdir)) {
 289         warn "opendir ``$catdir'': $!\n"; return 0;
 290     }
 291
 292     warn "open cat directory: ``$catdir''\n" if $verbose;
 293     foreach $file (readdir(D)) {
 294         next if $file =~ /^(\.|\.\.)$/; # skip current and parent directory
 295
 296         if ($file !~ /^[\w\-\+\[\.:]+\.\w+$/) {
 297             &garbage("$catdir/$file", "Assume garbage")
 298                 unless -d "$catdir/$file";
 299             next;
 300         }
 301
 302         if ($file !~ /\.gz$/ && $read{"$file.gz"}) {
 303             &garbage("$catdir/$file",
 304                      "Catpage unused, see compressed version");
 305         } elsif (!$read{$file}) {
 306             # maybe a bug in man(1)
 307             # if both manpage and catpage are uncompressed, man reformats
 308             # the manpage and puts a compressed catpage to the
 309             # already existing uncompressed catpage
 310             ($f = $file) =~ s/\.gz$//;
 311
 312             # man page is uncompressed, catpage is compressed
 313             next if $read{$f};
 314             &garbage("$catdir/$file", "Catpage without manpage");
 315         }
 316     }
 317     closedir D;
 318 }
 319
 320 sub garbage {
 321     local($file, @text) = @_;
 322
 323     warn "@text: ``$file''\n";
 324     if ($remove) {
 325         warn "unlink $file\n";
 326         unless ($print) {
 327             unlink($file) || warn "unlink $file: $!\n" ;
 328         }
 329     }
 330 }
 331
 332 sub nroff {
 333     local($man,$cat) = @_;
 334     local($nroff) = "nroff -T" . $dev_name . " -man | col";
 335     local($dev, $ino) = (stat($man))[01];
 336
 337     # It's a link
 338     if ($link{"$dev.$ino"}) {
 339         warn "Link: $link{\"$dev.$ino\"} -> $cat\n" if $verbose || $print;
 340
 341         return if $print;       # done
 342         unlink($cat);           # remove possible old link
 343
 344         unless (link($link{"$dev.$ino"}, $cat)) {
 345             warn "Link $cat: $!\n";
 346             $exit = 1;
 347         }
 348         return;
 349     } else {
 350         $cat = "$cat$ext" if $cat !~ /$ext$/;
 351         warn "Format: $man -> $cat\n" if $verbose || $print;
 352
 353         unless($print) {
 354             # man page is compressed
 355             if ($man =~ /$ext$/) {
 356                 $nroff = "zcat $man | tbl | $nroff";
 357             } else {
 358                 $nroff = "tbl $man | $nroff";
 359             }
 360
 361             # start formatting
 362             $tmp = "$cat.$tmp";        # for cleanup after signals
 363             system("$nroff | gzip > $cat.tmp");
 364             if ($?) {
 365                 # assume a fatal signal to nroff
 366                 &Exit("INT to system() function") if ($? == 2);
 367             } else {
 368                 rename("$cat.tmp", $cat);
 369             }
 370         }
 371     }
 372
 373     # dev/ino from manpage, path from catpage
 374     $link{"$dev.$ino"} = $cat;
 375 }
 376
 377 # Set correct [gn]roff output device name ([ng]roff's "-T" option)
 378 sub nroff_device {
 379   # Choose default output device name.
 380   $dev_name = "ascii";
 381
 382   if ($locale) {
 383      # Use "nroff -Tkoi8-r -man" to format russian manpages (if catman "-L"
 384      # option specified only).
 385      if ($local_suffix =~ '\.KOI8-R$') {
 386           $dev_name = "koi8-r";
 387      }
 388      # Use "nroff -Tlatin1 -man" to format ISO 8859-1 manpages
 389      elsif ($local_suffix =~ '\.ISO_?8859-15?$') {
 390           $dev_name = "latin1";
 391     }
 392   }
 393   warn "nroff output device name is $dev_name\n" if $verbose;
 394 }
 395
 396 # process directory
 397 sub process_dir {
 398   local($dir) = @_;
 399
 400   if (-e $dir && -d _ && -r _ && -x _) {
 401         warn "``$dir'' is not writable for you,\n" .
 402            "can only write to existing cat subdirs (if any)\n"
 403         if ! -w _ && $verbose;
 404         &parse_dir(&stripdir($dir));
 405   } else {
 406         warn "``$dir'' is not a directory or not read-/searchable for you\n";
 407         $exit = 1;
 408   }
 409 }
 410
 411 # convert locale name to short notation (ru_RU.KOI8-R -> ru.KOI8-R)
 412 sub short_locale_name {
 413   local($lname) = @_;
 414
 415   $lname =~ s|_[A-Z][A-Z]||;
 416   warn "short locale name is $lname\n" if $verbose && $locale;
 417
 418   return $lname;
 419 }
 420
 421 #############
 422 # main
 423 warn "Don't start this program as root, use:\n" .
 424     "echo $0 @ARGV | nice -5 su -m man\n" unless $>;
 425
 426 &variables;
 427 @argv = &parse(split(/[ :]/, join($", @ARGV)));
 428 &nroff_device;
 429 foreach $dir (@argv) {
 430     if ($locale) {
 431        if ($local_suffix ne "") {
 432           &process_dir($dir.'/'.$local_suffix);
 433           &process_dir($dir.'/'.&short_locale_name($local_suffix));
 434        }
 435     } else {
 436       &process_dir($dir);
 437     }
 438 }
 439 exit($exit);