1  #!/usr/bin/env perl
 2  
 3  use strict;
 4  use warnings;
 5  use autodie;
 6  use feature qw(switch);
 7  
 8  require 5.10.1;
 9  
10  $0 =~ s@.*/@@;
11  
12  MAIN:
13  {
14      my @xrefs;
15      my $see_also;
16  
17      @xrefs =
18        map { ".Xr $_->[0] $_->[1]" }
19        sort {
20               ( $a->[1] <=> $b->[1] )
21            || ( ( $b->[0] eq 'pkg' ) <=> ( $a->[0] eq 'pkg' ) )
22            || ( $a->[0] cmp $b->[0] )
23        }
24        map {
25          [m/^(\S+)\.(\d)$/]
26        } @ARGV;
27  
28      eval {
29          for my $man (@ARGV) {
30              my ($match) = ( $man =~ m/^(\S+)\./ );
31  
32              open READ,  "<$man";
33              open WRITE, ">$man.new";
34  
35              $see_also = undef;
36  
37              while (<READ>) {
38                  if (/^\.Sh SEE ALSO/) {
39                      $see_also = 1;
40                      print WRITE $_;
41                      print WRITE join( " ,\n", grep { !m/$match / } @xrefs ),
42                        "\n";
43                      next;
44                  }
45                  if ( $see_also && /^\.Xr/ ) {
46                      next;
47                  }
48                  print WRITE $_;
49              }
50              close READ;
51              close WRITE;
52  
53              rename "$man.new", $man;
54          }
55      };
56      given ($@) {
57          when (undef)  { exit 0; }
58          when ('')     { exit 0; }
59          when ('open') { die "$0: open() failed -- $@\n"; }
60          default       { die "$0: Error -- $@\n"; }
61      }
62      exit 0;
63  }