test we don't use vars and that we have use 5.006.
[imager.git] / xt / x30podlinkcheck.t
1 #!perl -w
2 use strict;
3 use Test::More;
4 BEGIN {
5   eval 'use Pod::Parser 1.50;';
6   plan skip_all => "Pod::Parser 1.50 required for podlinkcheck" if $@;
7 }
8 use File::Find;
9 use File::Spec::Functions qw(rel2abs abs2rel splitdir);
10
11 # external stuff we refer to
12 my @known =
13   qw(perl Affix::Infix2Postfix Parse::RecDescent GD Image::Magick Graphics::Magick CGI Image::ExifTool XSLoader DynaLoader Prima::Image IPA PDL);
14
15 # also known since we supply them, but we don't always install them
16 push @known, qw(Imager::Font::FT2 Imager::Font::W32 Imager::Font::T1
17    Imager::File::JPEG Imager::File::GIF Imager::File::PNG Imager::File::TIFF);
18
19 my @pod; # files with pod
20
21 my $base = rel2abs("blib/lib");
22
23 my @files;
24 find(sub {
25        -f && /\.(pod|pm)$/
26          and push @files, $File::Find::name;
27      }, $base);
28
29 my %targets = map { $_ => {} } @known;
30 my %item_in;
31
32 for my $file (@files) {
33   my $parser = PodPreparse->new;
34
35   my $link = abs2rel($file, $base);
36   $link =~ s/\.(pod|pm|pl|PL)$//;
37   $link = join("::", splitdir($link));
38
39   $parser->{'targets'} = \%targets;
40   $parser->{'link'} = $link;
41   $parser->{'file'} = $file;
42   $parser->{item_in} = \%item_in;
43   $parser->parse_from_file($file);
44   if ($targets{$link}) {
45     push @pod, $file;
46   }
47 }
48
49 plan tests => scalar(@pod);
50
51 for my $file (@pod) {
52   my $parser = PodLinkCheck->new;
53   $parser->{"targets"} = \%targets;
54   my $relfile = abs2rel($file, $base);
55   (my $link = $relfile) =~ s/\.(pod|pm|pl|PL)$//;
56   $link = join("::", splitdir($link));
57   $parser->{"file"} = $relfile;
58   $parser->{"link"} = $link;
59   my @errors;
60   $parser->{"errors"} = \@errors;
61   $parser->{item_in} = \%item_in;
62   $parser->parse_from_file($file);
63
64   unless (ok(!@errors, "check links in $relfile")) {
65     print STDERR "# $_\n" for @errors;
66   }
67 }
68
69 package PodPreparse;
70 BEGIN { our @ISA = qw(Pod::Parser); }
71
72 sub command {
73   my ($self, $cmd, $para) = @_;
74
75   my $targets = $self->{"targets"};
76   my $link = $self->{"link"};
77   $targets->{$link} ||= {};
78
79   if ($cmd =~ /^(head[1-5]|item)/) {
80     $para =~ s/X<.*?>//g;
81     $para =~ s/\s+$//;
82     $targets->{$link}{$para} = 1;
83     push @{$self->{item_in}{$para}}, $link;
84   }
85 }
86
87 sub verbatim {}
88
89 sub textblock {}
90
91 package PodLinkCheck;
92 BEGIN { our @ISA = qw(Pod::Parser); }
93
94 sub command {}
95
96 sub verbatim {}
97
98 sub textblock {
99   my ($self, $para, $line_num) = @_;
100
101   $self->parse_text
102     (
103      { -expand_seq => "sequence" },
104      $para, $line_num,
105     );
106 }
107
108 sub sequence {
109   my ($self, $seq) = @_;
110
111   if ($seq->cmd_name eq "L") {
112     my $raw = $seq->raw_text;
113     my $base_link = $seq->parse_tree->raw_text;
114     (my $link = $base_link) =~ s/.*\|//s;
115     $link =~ /^(https?|ftp|mailto):/
116       and return '';
117     my ($pod, $part) = split m(/), $link, 2;
118     $pod ||= $self->{link};
119     if ($part) {
120       $part =~ s/^\"//;
121       $part =~ s/"$//;
122     }
123     my $targets = $self->{targets};
124     my $errors = $self->{errors};
125     (undef, my $line) = $seq->file_line;
126
127     if (!$targets->{$pod}) {
128       push @$errors, "$line: No $pod found ($raw)";
129     }
130     elsif ($part && !$targets{$pod}{$part}) {
131       push @$errors, "$line: No item/section '$part' found in $pod ($raw)";
132       if ($self->{item_in}{$part}) {
133         push @$errors, "  $part can be found in:";
134         push @$errors, map "     $_", @{$self->{item_in}{$part}};
135       }
136     }
137   }
138
139   return $seq->raw_text;
140 }
141