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