5 eval 'use Pod::Parser 1.50;';
6 plan skip_all => "Pod::Parser 1.50 required for podlinkcheck" if $@;
9 use File::Spec::Functions qw(rel2abs abs2rel splitdir);
11 # external stuff we refer to
13 qw(perl Affix::Infix2Postfix Parse::RecDescent GD Image::Magick Graphics::Magick CGI Image::ExifTool XSLoader DynaLoader Prima::Image IPA PDL);
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);
19 my @pod; # files with pod
21 my $base = rel2abs("blib/lib");
26 and push @files, $File::Find::name;
29 my %targets = map { $_ => {} } @known;
32 for my $file (@files) {
33 my $parser = PodPreparse->new;
35 my $link = abs2rel($file, $base);
36 $link =~ s/\.(pod|pm|pl|PL)$//;
37 $link = join("::", splitdir($link));
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}) {
49 plan tests => scalar(@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;
60 $parser->{"errors"} = \@errors;
61 $parser->{item_in} = \%item_in;
62 $parser->parse_from_file($file);
64 unless (ok(!@errors, "check links in $relfile")) {
65 print STDERR "# $_\n" for @errors;
70 BEGIN { our @ISA = qw(Pod::Parser); }
73 my ($self, $cmd, $para) = @_;
75 my $targets = $self->{"targets"};
76 my $link = $self->{"link"};
77 $targets->{$link} ||= {};
79 if ($cmd =~ /^(head[1-5]|item)/) {
82 $targets->{$link}{$para} = 1;
83 push @{$self->{item_in}{$para}}, $link;
92 BEGIN { our @ISA = qw(Pod::Parser); }
99 my ($self, $para, $line_num) = @_;
103 { -expand_seq => "sequence" },
109 my ($self, $seq) = @_;
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):/
117 my ($pod, $part) = split m(/), $link, 2;
118 $pod ||= $self->{link};
123 my $targets = $self->{targets};
124 my $errors = $self->{errors};
125 (undef, my $line) = $seq->file_line;
127 if (!$targets->{$pod}) {
128 push @$errors, "$line: No $pod found ($raw)";
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}};
139 return $seq->raw_text;