2 # Copyright 2002-2016 The OpenSSL Project Authors. All Rights Reserved.
4 # Licensed under the OpenSSL license (the "License"). You may not use
5 # this file except in compliance with the License. You can obtain a copy
6 # in the file LICENSE in the source distribution or at
7 # https://www.openssl.org/source/license.html
15 # Collection of links in each POD file.
16 # filename => [ "foo(1)", "bar(3)", ... ]
17 my %link_collection = ();
18 # Collection of names in each POD file.
19 # "name(s)" => filename
20 my %name_collection = ();
24 $filename =~ m|man(\d)/|;
26 my $simplename = basename($filename, ".pod");
32 open POD, $filename or die "Couldn't open $filename, $!";
37 $contents =~ /=head1 NAME([^=]*)=head1 /ms;
39 unless (defined $tmp) {
40 warn "weird name section in $filename\n";
46 my @names = map { s/\s+//g; $_ } split(/,/, $tmp);
47 unless (grep { $simplename eq $_ } @names) {
48 warn "$simplename missing among the names in $filename\n";
49 push @names, $simplename;
51 foreach my $name (@names) {
53 my $namesection = "$name($section)";
54 if (exists $name_collection{$namesection}) {
55 warn "$namesection, found in $filename, already exists in $name_collection{$namesection}\n";
58 $name_collection{$namesection} = $filename;
63 map { map { s/\s+//g; $_ } split(/,/, $_) }
64 $contents =~ /=for\s+comment\s+foreign\s+manuals:\s*(.*)\n\n/;
65 foreach (@foreign_names) {
66 $name_collection{$_} = undef; # It still exists!
69 my @links = $contents =~ /L<
70 # if the link is of the form L<something|name(s)>,
71 # then remove 'something'. Note that 'something'
72 # may contain POD codes as well...
73 (?:(?:[^\|]|<[^>]*>)*\|)?
74 # we're only interested in referenses that have
75 # a one digit section number
78 $link_collection{$filename} = [ @links ];
84 foreach my $filename (sort keys %link_collection) {
85 foreach my $link (@{$link_collection{$filename}}) {
86 warn "$link in $filename refers to a non-existing manual\n"
87 unless exists $name_collection{$link};
94 foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) {
97 check() unless $errs > 0;