Next time I'll run cvs update to make sure I've added
[dragonfly.git] / 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);