mirrors/openssl
0
0
Fork 0
mirror of https://github.com/openssl/openssl.git synced 2024-12-14 04:24:23 +08:00
Code Issues Packages Projects Releases Wiki Activity

Add util/check-doc-links.pl, to be used to check referenses in manuals

Browse Source 
Reviewed-by: Rich Salz <rsalz@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/1900)
This commit is contained in:
Richard Levitte 2016-11-11 09:19:52 +01:00
parent 6e290a25c2
commit d36bae1aab
1 changed files with 99 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
util/check-doc-links.pl Normal file
View File

@ -0,0 +1,99 @@
#! /usr/bin/env perl
# Copyright 2002-2016 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the OpenSSL license (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
require 5.10.0;
use warnings;
use strict;
use File::Basename;
# 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 collect {
my $filename = shift;
$filename =~ m|man(\d)/|;
my $section = $1;
my $simplename = basename($filename, ".pod");
my $err = 0;
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) {
warn "weird name section in $filename\n";
return 1;
}
$tmp =~ tr/\n/ /;
$tmp =~ s/-.*//g;
my @names = map { s/\s+//g; $_ } split(/,/, $tmp);
unless (grep { $simplename eq $_ } @names) {
warn "$simplename missing among the names in $filename\n";
push @names, $simplename;
}
foreach my $name (@names) {
next if $name eq "";
my $namesection = "$name($section)";
if (exists $name_collection{$namesection}) {
warn "$namesection, found in $filename, already exists in $name_collection{$namesection}\n";
$err++;
} else {
$name_collection{$namesection} = $filename;
}
}
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 ];
return $err;
}
sub check {
foreach my $filename (sort keys %link_collection) {
foreach my $link (@{$link_collection{$filename}}) {
warn "$link in $filename refers to a non-existing manual\n"
unless exists $name_collection{$link};
}
}
}
my $errs = 0;
foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) {
$errs += collect($_);
}
check() unless $errs > 0;
exit;