|
@@ -23,11 +23,13 @@ our($opt_s);
|
|
|
our($opt_u);
|
|
|
our($opt_h);
|
|
|
our($opt_n);
|
|
|
+our($opt_l);
|
|
|
|
|
|
sub help()
|
|
|
{
|
|
|
print <<EOF;
|
|
|
Find small errors (nits) in documentation. Options:
|
|
|
+ -l Print bogus links
|
|
|
-n Print nits in POD pages
|
|
|
-s Also print missing sections in POD pages (implies -n)
|
|
|
-u List undocumented functions
|
|
@@ -260,18 +262,100 @@ sub printem()
|
|
|
}
|
|
|
|
|
|
|
|
|
-getopts('nshu');
|
|
|
+# Collection of links in each POD file.
|
|
|
+# filename => [ "foo(1)", "bar(3)", ... ]
|
|
|
+my %link_collection = ();
|
|
|
+# Collection of names in each POD file.
|
|
|
+# "name(s)" => filename
|
|
|
+my %name_collection = ();
|
|
|
+
|
|
|
+sub collectnames {
|
|
|
+ my $filename = shift;
|
|
|
+ $filename =~ m|man(\d)/|;
|
|
|
+ my $section = $1;
|
|
|
+ my $simplename = basename($filename, ".pod");
|
|
|
+ my $id = "${filename}:1:";
|
|
|
+
|
|
|
+ my $contents = '';
|
|
|
+ {
|
|
|
+ local $/ = undef;
|
|
|
+ open POD, $filename or die "Couldn't open $filename, $!";
|
|
|
+ $contents = <POD>;
|
|
|
+ close POD;
|
|
|
+ }
|
|
|
+
|
|
|
+ $contents =~ /=head1 NAME([^=]*)=head1 /ms;
|
|
|
+ my $tmp = $1;
|
|
|
+ unless (defined $tmp) {
|
|
|
+ print "$id weird name section\n";
|
|
|
+ return;
|
|
|
+ }
|
|
|
+ $tmp =~ tr/\n/ /;
|
|
|
+ $tmp =~ s/-.*//g;
|
|
|
+
|
|
|
+ my @names = map { s/\s+//g; $_ } split(/,/, $tmp);
|
|
|
+ unless (grep { $simplename eq $_ } @names) {
|
|
|
+ print "$id missing $simplename\n";
|
|
|
+ push @names, $simplename;
|
|
|
+ }
|
|
|
+ foreach my $name (@names) {
|
|
|
+ next if $name eq "";
|
|
|
+ my $name_sec = "$name($section)";
|
|
|
+ if (! exists $name_collection{$name_sec}) {
|
|
|
+ $name_collection{$name_sec} = $filename;
|
|
|
+ } else { #elsif ($filename ne $name_collection{$name_sec}) {
|
|
|
+ print "$id $name_sec also in $name_collection{$name_sec}\n";
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ my @foreign_names =
|
|
|
+ map { map { s/\s+//g; $_ } split(/,/, $_) }
|
|
|
+ $contents =~ /=for\s+comment\s+foreign\s+manuals:\s*(.*)\n\n/;
|
|
|
+ foreach (@foreign_names) {
|
|
|
+ $name_collection{$_} = undef; # It still exists!
|
|
|
+ }
|
|
|
+
|
|
|
+ my @links = $contents =~ /L<
|
|
|
+ # if the link is of the form L<something|name(s)>,
|
|
|
+ # then remove 'something'. Note that 'something'
|
|
|
+ # may contain POD codes as well...
|
|
|
+ (?:(?:[^\|]|<[^>]*>)*\|)?
|
|
|
+ # we're only interested in referenses that have
|
|
|
+ # a one digit section number
|
|
|
+ ([^\/>\(]+\(\d\))
|
|
|
+ /gx;
|
|
|
+ $link_collection{$filename} = [ @links ];
|
|
|
+}
|
|
|
+
|
|
|
+sub checklinks {
|
|
|
+ foreach my $filename (sort keys %link_collection) {
|
|
|
+ foreach my $link (@{$link_collection{$filename}}) {
|
|
|
+ print "${filename}:1: reference to non-existing $link\n"
|
|
|
+ unless exists $name_collection{$link};
|
|
|
+ }
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+getopts('lnshu');
|
|
|
|
|
|
&help() if ( $opt_h );
|
|
|
|
|
|
-die "Need one of -n -s or -u flags.\n"
|
|
|
- unless $opt_n or $opt_s or $opt_u;
|
|
|
+die "Need one of -l -n -s or -u flags.\n"
|
|
|
+ unless $opt_l or $opt_n or $opt_s or $opt_u;
|
|
|
|
|
|
if ( $opt_n or $opt_s ) {
|
|
|
foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) {
|
|
|
&check($_);
|
|
|
}
|
|
|
}
|
|
|
+
|
|
|
+if ( $opt_l ) {
|
|
|
+ foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) {
|
|
|
+ collectnames($_);
|
|
|
+ }
|
|
|
+ checklinks();
|
|
|
+}
|
|
|
+
|
|
|
if ( $opt_u ) {
|
|
|
my %temp = &getdocced('doc/man3');
|
|
|
foreach ( keys %temp ) {
|