1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
#!perl -w
use strict;
use Test::More;
$ENV{AUTOMATED_TESTING} || $ENV{IMAGER_AUTHOR_TESTING}
or plan skip_all => "POD only tested under automated or author testing";
BEGIN {
eval 'use Pod::Parser 1.50;';
plan skip_all => "Pod::Parser 1.50 required for podlinkcheck" if $@;
}
use File::Spec::Functions qw(rel2abs abs2rel splitdir);
use ExtUtils::Manifest qw(maniread);
# this test is intended to catch errors like in
# https://rt.cpan.org/Ticket/Display.html?id=85413
my @pod; # files with pod
my $base = rel2abs(".");
my $manifest = maniread();
my @files = sort grep /\.(pod|pm)$/ && !/^inc/, keys %$manifest;
my %item_in;
for my $file (@files) {
my $parser = PodPreparse->new;
$parser->parse_from_file($file);
if ($parser->{is_pod}) {
push @pod, $file;
}
}
plan tests => 3 * scalar(@pod);
my @req_head1s = qw(NAME DESCRIPTION AUTHOR);
for my $file (@pod) {
my $parser = PodStructCheck->new;
my $relfile = abs2rel($file, $base);
$parser->{bad_quotes} = [];
$parser->{dup_words} = [];
$parser->parse_from_file($file);
my @missing;
for my $head (@req_head1s) {
push @missing, $head unless $parser->{head1s}{$head};
}
unless (ok(!@missing, "$relfile: check missing headers")) {
diag "$relfile: missing head1s @missing\n";
}
unless (ok(!@{$parser->{bad_quotes}}, "$relfile: check for bad quotes")) {
diag "$relfile:$_->[1]: bad quote in: $_->[0]"
for @{$parser->{bad_quotes}};
}
unless (ok(!@{$parser->{dup_words}}, "$relfile: check for duplicate words")) {
diag "$relfile:$_->[1]: dup word '$_->[0]' in: $_->[2]"
for @{$parser->{dup_words}};
}
}
package PodPreparse;
BEGIN { our @ISA = qw(Pod::Parser); }
sub command {
my ($self, $cmd, $para) = @_;
$self->{is_pod} = 1;
}
sub verbatim {}
sub textblock {}
package PodStructCheck;
BEGIN { our @ISA = qw(Pod::Parser); }
sub command {
my ($self, $command, $paragraph, $line_num) = @_;
if ($command eq "head1") {
$paragraph =~ s/\s+\z//;
$self->{head1s}{$paragraph} = 1;
if ($paragraph =~ /\A[^']*'\z/
|| $paragraph =~ /\A[^"]*"\z/
|| $paragraph =~ /\A'[^']*\z/
|| $paragraph =~ /\A"[^"]*\z/) {
push @{$self->{bad_quotes}}, [ $paragraph, $line_num ];
}
}
}
sub verbatim {}
sub textblock {
my ($self, $text, $line_num) = @_;
if (my ($sample, $word) = $text =~ /(.{0,10}\b(\w+)\s+\2\b.{0,10})/s) {
# avoid catching "C C<something to do with C>"
if ($word ne "C") {
push @{$self->{dup_words}}, [ $word, $line_num, $sample ];
}
}
}
sub sequence {
}
|
