Initial import from FreeBSD RELENG_4:
[dragonfly.git] / share / man / man0 / xrs.pl
1 #!/usr/bin/perl
2 # Copyright (c) 1996 Wolfram Schneider <wosch@FreeBSD.org>. Berlin.
3 # All rights reserved.
4 #
5 # xrs - detect unsorted cross references in section SEE ALSO
6 #
7 # Cross references in the SEE ALSO section should
8 # be sorted by section number, and then placed in alphabetical
9 # order and comma separated.  For example:
10 #
11 # ls(1),  ps(1),  group(5),  passwd(5).
12 #
13 # The last entry may be finished with a dot `.'
14 #
15 # or a source example:.
16 # .Sh SEE ALSO
17 # .Xr foo 1 ,
18 # .Xr bla 2 ,
19 # .Xr foobar 8
20 # .Sh HISTORY
21 #
22 # usage: xrs manpages ...
23 #
24 # $FreeBSD: src/share/man/man0/xrs.pl,v 1.5 1999/08/28 00:19:39 peter Exp $
25
26 sub mysort {
27
28     local(@c) = split($",$a);
29     local(@d) = split($",$b);
30
31     local($ret) = ($c[2] <=> $d[2]);
32                 
33     return $ret if $ret;
34     return $c[1] cmp $d[1];
35 }
36
37 sub usage { die "usage: xrs manpages ...\n"; }
38
39 sub compare {
40     local(*a, *b) = @_;
41
42     return 1 if ($#a != $#b);
43
44     for($i = 0; $i <= $#a; $i++) {
45         return 1 if
46             $a[$i] ne $b[$i];
47     }
48
49     for ($i = 0; $i < $#a; $i++) {
50         return 1 if $a[$i] !~ /\s,\s*$/;
51     }
52
53     return 1 if $a[$#a] =~ /\s,\s*$/;
54     return 1 if $a[$#a] =~ /^.Xr\s+\S+\s+\S+\s+[^.\s]/;
55     return 0;
56 }
57
58 &usage if $#ARGV >= 0 && $ARGV[0] =~ /^-\?|h/;
59
60 while(<>) {
61     if (/^\.Sh\s/ && /"?SEE\s+ALSO"?/) {
62         $file = $ARGV;
63         @a = ();
64         while(<>) {
65             last if $file ne $ARGV;
66
67             next if /^\.\\"\s/; # " ignore comments
68             # next if m%^/[^/]+/%; # ignore absolute path names
69             if (!/^\.(Xr|Fn)\s/) {
70                 if (!/^\.(Sh|Rs|\\"|Pp|br)\s*/ && !/^\s*$/) {
71                     warn "Oops: $ARGV $_";
72                 }
73                 last;
74             }
75             tr/A-Z/a-z/;
76             push(@a, $_);
77         }
78         @b = sort mysort @a;
79         if (&compare(*a,*b)) {
80             print "$file\n";
81         }
82     }
83     last if eof();
84 }