Allow `L<text|schem:...>` tags.
As of the latest `perlpod` and `perlpodspec` committed to blead and forthcoming in Perl 5.12, and now included in Pod::Simple 3.11, on CPAN, the formerly disallowed `L<text|schem:...>` tags are now allowed. Pod::Simple 3.11 has been updated to take full advantage of this format in all output formats (including plain text). Thus, it makes sense for Pod::Test to now allow this tag. It also simplifies the code a bit. :-)
David E. Wheeler
14 years ago
| 64 | 64 |
|
| 65 | 65 |
use Test::Builder;
|
| 66 | 66 |
use File::Spec;
|
|
67 |
use Pod::Simple;
|
| 67 | 68 |
|
| 68 | 69 |
our %ignore_dirs = (
|
| 69 | 70 |
'.bzr' => 'Bazaar',
|
|
| 125 | 126 |
return;
|
| 126 | 127 |
}
|
| 127 | 128 |
|
| 128 | |
my $checker = Test::Pod::_parser->new;
|
|
129 |
my $checker = Pod::Simple->new;
|
| 129 | 130 |
|
| 130 | 131 |
$checker->output_string( \my $trash ); # Ignore any output
|
| 131 | 132 |
$checker->parse_file( $file );
|
|
| 289 | 290 |
=cut
|
| 290 | 291 |
|
| 291 | 292 |
1;
|
| 292 | |
|
| 293 | |
package Test::Pod::_parser;
|
| 294 | |
use base 'Pod::Simple';
|
| 295 | |
use strict;
|
| 296 | |
|
| 297 | |
sub _handle_element_start {
|
| 298 | |
my($parser, $element_name, $attr_hash_r) = @_;
|
| 299 | |
|
| 300 | |
# Curiously, Pod::Simple supports L<text|scheme:...> rather well.
|
| 301 | |
|
| 302 | |
if( $element_name eq "L" and $attr_hash_r->{type} eq "url") {
|
| 303 | |
$parser->{_state_of_concern}{'Lurl'} = $attr_hash_r->{to};
|
| 304 | |
}
|
| 305 | |
|
| 306 | |
return $parser->SUPER::_handle_element_start(@_);
|
| 307 | |
}
|
| 308 | |
|
| 309 | |
sub _handle_element_end {
|
| 310 | |
my($parser, $element_name) = @_;
|
| 311 | |
|
| 312 | |
delete $parser->{_state_of_concern}{'Lurl'}
|
| 313 | |
if $element_name eq "L" and exists $parser->{_state_of_concern}{'Lurl'};
|
| 314 | |
|
| 315 | |
return $parser->SUPER::_handle_element_end(@_);
|
| 316 | |
}
|
| 317 | |
|
| 318 | |
sub _handle_text {
|
| 319 | |
my($parser, $text) = @_;
|
| 320 | |
if( my $href = $parser->{_state_of_concern}{'Lurl'} ) {
|
| 321 | |
if( $href ne $text ) {
|
| 322 | |
my $line = $parser->line_count() -2; # XXX: -2, WHY WHY WHY??
|
| 323 | |
|
| 324 | |
$parser->whine($line, "L<text|scheme:...> is invalid according to perlpod");
|
| 325 | |
}
|
| 326 | |
}
|
| 327 | |
|
| 328 | |
return $parser->SUPER::_handle_text(@_);
|
| 329 | |
}
|
| 330 | |
|
| 331 | |
1;
|
| 332 | |
|
| 0 | |
|
| 1 | |
=head1 COPYRIGHT
|
| 2 | |
|
| 3 | |
Copyright 2009, Paul Miller C<< <jettero@cpan.org> >>
|
| 4 | |
|
| 5 | |
|
| 6 | |
... test text, please ignore
|
| 7 | |
|
| 8 | |
=head1 SEE ALSO
|
| 9 | |
|
| 10 | |
... test text, please ignore
|
| 11 | |
|
| 12 | |
Invalid according to L<perlpod/Formatting Codes>:
|
| 13 | |
L<Paul's Perl Modules|http://voltar.org/perl>
|
| 14 | |
|
| 15 | |
This should be OK:
|
| 16 | |
|
| 17 | |
L<Paul's Perl Modules|http://voltar.org/perl>
|
| 18 | |
|
| 19 | |
This should also be OK: L<http://voltar.org/perl>
|
| 20 | |
|
| 21 | |
... test text, please ignore
|
| 22 | |
|
| 23 | |
=cut
|
| 24 | |
|
| 0 | |
#!perl -T
|
| 1 | |
|
| 2 | |
use strict;
|
| 3 | |
use warnings;
|
| 4 | |
|
| 5 | |
use Test::Builder::Tester tests => 2;
|
| 6 | |
use Test::More;
|
| 7 | |
|
| 8 | |
BEGIN {
|
| 9 | |
use_ok( 'Test::Pod' );
|
| 10 | |
}
|
| 11 | |
|
| 12 | |
my $file = 't/link.pod';
|
| 13 | |
test_out( "not ok 1 - POD test for $file" );
|
| 14 | |
pod_file_ok( $file );
|
| 15 | |
test_fail(-1);
|
| 16 | |
test_diag(
|
| 17 | |
"$file (14): L<text|scheme:...> is invalid according to perlpod",
|
| 18 | |
);
|
| 19 | |
test_test( "$file is bad" );
|