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