summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2012-02-18 18:21:44 -0700
committerKarl Williamson <public@khwilliamson.com>2012-02-18 18:26:40 -0700
commitd8b5658818af0eb30544491d4891d699ec21bd1f (patch)
treec28582c748e9f34c4c543b22da1e46a78b5b99e9
parentcab3eb14c742068a649b196e51be17ee0a0d7cda (diff)
downloadperl-khw/pod-checker-final.tar.gz
podcheck.t: Refactor for new Pod::Checkerkhw/pod-checker-final
podcheck.t sublcasses Pod::Checker. That has been rewritten, and so podcheck.t must be as well to fit into the new scheme.
-rw-r--r--t/porting/podcheck.t603
1 files changed, 417 insertions, 186 deletions
diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t
index 91a4159173..e6ae9b0107 100644
--- a/t/porting/podcheck.t
+++ b/t/porting/podcheck.t
@@ -426,19 +426,20 @@ close $manifest_fh, or die "Can't close $MANIFEST";
# Pod::Checker messages to suppress
my @suppressed_messages = (
- "(section) in", # Checker is wrong to flag this
- "multiple occurrence of link target", # We catch independently the ones
- # that are real problems.
- "unescaped <>",
- "Entity number out of range", # Checker outputs this for anything above
- # 255, but in fact all Unicode is valid
+ qr/\(section\) in/, # Checker is wrong to flag this
+ qr/multiple occurrences \(\d+\) of link target/, # We catch independently the
+ # ones that are real problems.
+ qr/unescaped <>/,
+ qr/Entity number out of range/, # Checker outputs this for anything above
+ # 255, but in fact all Unicode is valid
+ qr/line containing nothing but whitespace in paragraph/,
);
sub suppressed {
# Returns bool as to if input message is one that is to be suppressed
my $message = shift;
- return grep { $message =~ /^\Q$_/i } @suppressed_messages;
+ return grep { $message =~ /^$_/i } @suppressed_messages;
}
{ # Closure to contain a simple subset of test.pl. This is to get rid of the
@@ -575,36 +576,54 @@ package My::Pod::Checker { # Extend Pod::Checker
# Uses inside out hash to protect from typos
# For new fields, remember to add to destructor DESTROY()
- my %indents; # Stack of indents from =over's in effect for
- # current line
+ my %CFL_text; # The text comprising the current C<>, F<>, or L<>
+ my %C_text; # If defined, are in a C<> section, and includes
+ # the accumulated text from that
my %current_indent; # Current line's indent
my %filename; # The pod is store in this file
- my %skip; # is SKIP set for this pod
+ my %in_CFL; # count of stacked C<>, F<>, L<> directives
+ my %indents; # Stack of indents from =over's in effect for
+ # current line
+ my %in_for; # true if in a =for or =begin
my %in_NAME; # true if within NAME section
- my %in_begin; # true if within =begin section
+ my %in_X; # true if in a X<>
my %linkable_item; # Bool: if the latest =item is linkable. It isn't
# for bullet and number lists
my %linkable_nodes; # Pod::Checker adds all =items to its node list,
# but not all =items are linkable to
+ my %running_CFL_text; # The current text that is being accumulated until
+ # an end_FOO is found, and this includes any C<>,
+ # F<>, or L<> directives.
+ my %running_simple_text; # The currentt text that is being accumulated
+ # until an end_FOO is found, and all directives
+ # have been expanded into plain text
+ my %seen_any_text; # true if have any user-specified text
my %seen_encoding_cmd; # true if have =encoding earlier
- my %command_count; # Number of commands seen
- my %seen_pod_cmd; # true if have =pod earlier
+ my %skip; # is SKIP set for this pod
+ my %start_line; # the first input line number in the the thing
+ # currently being worked on
my %warned_encoding; # true if already have warned about =encoding
# problems
sub DESTROY {
my $addr = Scalar::Util::refaddr $_[0];
- delete $command_count{$addr};
+ delete $CFL_text{$addr};
+ delete $C_text{$addr};
delete $current_indent{$addr};
delete $filename{$addr};
- delete $in_begin{$addr};
+ delete $in_CFL{$addr};
delete $indents{$addr};
+ delete $in_for{$addr};
delete $in_NAME{$addr};
+ delete $in_X{$addr};
delete $linkable_item{$addr};
delete $linkable_nodes{$addr};
+ delete $running_CFL_text{$addr};
+ delete $running_simple_text{$addr};
+ delete $seen_any_text{$addr};
delete $seen_encoding_cmd{$addr};
- delete $seen_pod_cmd{$addr};
delete $skip{$addr};
+ delete $start_line{$addr};
delete $warned_encoding{$addr};
return;
}
@@ -616,14 +635,14 @@ package My::Pod::Checker { # Extend Pod::Checker
my $self = $class->SUPER::new(-quiet => 1,
-warnings => $Warnings_Level);
my $addr = Scalar::Util::refaddr $self;
- $command_count{$addr} = 0;
$current_indent{$addr} = 0;
$filename{$addr} = $filename;
- $in_begin{$addr} = 0;
+ $in_X{$addr} = 0;
+ $in_CFL{$addr} = 0;
$in_NAME{$addr} = 0;
$linkable_item{$addr} = 0;
$seen_encoding_cmd{$addr} = 0;
- $seen_pod_cmd{$addr} = 0;
+ $seen_any_text{$addr} = 0;
$warned_encoding{$addr} = 0;
return $self;
}
@@ -723,104 +742,204 @@ package My::Pod::Checker { # Extend Pod::Checker
Carp::carp("Couldn't extract line number from '$message'") if $message =~ /line \d+/;
push @{$problems{$filename{$addr}}{$message}}, $opts;
- #push @{$problems{$self->get_filename}{$message}}, $opts;
}
- sub check_encoding { # Does it need an =encoding statement?
- my ($self, $paragraph, $line_num, $pod_para) = @_;
-
- # Do nothing if there is an =encoding in the file, or if the line
- # doesn't require an =encoding, or have already warned.
+ # This overrides something that unfortunately is in Pod::Simple::BlackBox
+ sub _handle_encoding_line {
+ my $self = shift;
my $addr = Scalar::Util::refaddr $self;
- return if $seen_encoding_cmd{$addr}
- || $warned_encoding{$addr}
- || $paragraph !~ /\P{ASCII}/;
-
- $warned_encoding{$addr} = 1;
- my ($file, $line) = $pod_para->file_line;
- $self->poderror({ -line => $line, -file => $file,
- -msg => $need_encoding
- });
- return;
+ if ($seen_any_text{$addr}) {
+ $self->poderror({ -line => $start_line{$addr}, # XXX early line number
+ -msg => $encoding_first
+ });
+ }
+ $seen_encoding_cmd{$addr} = $_[0] =~ s/^=encoding\s+//r;
+ return $self->SUPER::_handle_encoding_line(@_);
}
- sub verbatim {
- my ($self, $paragraph, $line_num, $pod_para) = @_;
- $self->check_encoding($paragraph, $line_num, $pod_para);
-
- $self->SUPER::verbatim($paragraph, $line_num, $pod_para);
+ sub handle_text {
+ # This is called by the parent class to deal with any straight text.
+ # We mostly just append this to the running current value which will
+ # be dealt with upon the end of the current construct, like a
+ # paragraph. But certain things don't contribute to checking the pod
+ # and are ignored. We also have set flags to indicate this text is
+ # going towards constructing certain constructs, and handle those
+ # specially.
+ my $self = shift;
my $addr = Scalar::Util::refaddr $self;
- # Pick up the name, since the parent class doesn't in verbatim
- # NAMEs; so treat as non-verbatim. The parent class only allows one
- # paragraph in a NAME section, so if there is an extra blank line, it
- # will trigger a message, but such a blank line is harmless, so skip
- # in that case.
- if ($in_NAME{$addr} && $paragraph =~ /\S/) {
- $self->textblock($paragraph, $line_num, $pod_para);
+ $seen_any_text{$addr} = 1;
+
+ my $return = $self->SUPER::handle_text(@_);
+
+ if ($in_X{$addr} || $in_for{$addr}) { # ignore
+ return $return;
}
- my @lines = split /^/, $paragraph;
- for my $i (0 .. @lines - 1) {
- if ( my $encoding = $seen_encoding_cmd{$addr} ) {
- require Encode;
- $lines[$i] = Encode::decode($encoding, $lines[$i]);
- }
- $lines[$i] =~ s/\s+$//;
- my $indent = $self->get_current_indent;
- my $exceeds = length(Text::Tabs::expand($lines[$i]))
- + $indent - $MAX_LINE_LENGTH;
- next unless $exceeds > 0;
- my ($file, $line) = $pod_para->file_line;
- $self->poderror({ -line => $line + $i, -file => $file,
- -msg => $line_length,
- parameter => "+$exceeds (including " . ($indent - $INDENT) . " from =over's)",
- });
+ my $text = join "\n", @_;
+ $running_simple_text{$addr} .= $text;
+
+ # Warn once on non-ASCII if no =encoding line
+ if ( ! $seen_encoding_cmd{$addr}
+ && ! $warned_encoding{$addr}
+ && $text =~ /\P{ASCII}/)
+ {
+ $self->poderror({ -line => $start_line{$addr},
+ -msg => $need_encoding
+ });
+ $warned_encoding{$addr} = 1;
+ }
+
+ # Keep a separate tabs on C<>, F<>, and L<> directives, and one
+ # especially for C<> ones.
+ if ($in_CFL{$addr}) {
+ $CFL_text{$addr} .= $text;
+ $C_text{$addr} .= $text if defined $C_text{$addr};
}
+ else {
+ # This variable is updated instead in the corresponding C, F, or L
+ # handler.addr
+ $running_CFL_text{$addr} .= $text;
+ }
+
+ return $return;
}
- sub textblock {
- my ($self, $paragraph, $line_num, $pod_para) = @_;
- $self->check_encoding($paragraph, $line_num, $pod_para);
+ # The start_FOO routines check that somehow a C<> construct hasn't escaped
+ # without being checked, and initialize things and call the parent class's
+ # equivalent routine.
+
+ # The end_FOO routines close things off, and check the text that has been
+ # accumulated for FOO, then call the parent's corresponding routine.
- $self->SUPER::textblock($paragraph, $line_num, $pod_para);
+ sub start_Para {
+ my $self = shift;
+ check_see_but_not_link($self);
- my ($file, $line) = $pod_para->file_line;
my $addr = Scalar::Util::refaddr $self;
- if ($in_NAME{$addr}) {
- if (! $self->name) {
- my $text = $self->interpolate($paragraph, $line_num);
- if ($text =~ /^\s*(\S+?)\s*$/) {
- $self->name($1);
- $self->poderror({ -line => $line, -file => $file,
- -msg => $missing_name_description,
- parameter => $1});
- }
- }
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+ return $self->SUPER::start_Para(@_);
+ }
+
+ sub start_item_text {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ # This is the only =item that is linkable
+ $linkable_item{$addr} = 1;
+
+ return $self->SUPER::start_item_text(@_);
+ }
+
+ sub start_item_number {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ return $self->SUPER::start_item_number(@_);
+ }
+
+ sub start_item_bullet {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ return $self->SUPER::start_item_bullet(@_);
+ }
+
+ sub end_item { # No difference in =item types endings
+ my $self = shift;
+ check_see_but_not_link($self);
+ return $self->SUPER::end_item(@_);
+ }
+
+ sub start_over {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ # Save this indent on a stack, and keep track of total indent
+ my $indent = $_[0]{'indent'};
+ push @{$indents{$addr}}, $indent;
+ $current_indent{$addr} += $indent;
+
+ return $self->SUPER::start_over(@_);
+ }
+
+ sub end_over {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+
+ # Pop current indent
+ if (@{$indents{$addr}}) {
+ $current_indent{$addr} -= pop @{$indents{$addr}};
+ }
+ else {
+ # =back without corresponding =over, but should have
+ # warned already
+ $current_indent{$addr} = 0;
}
- $paragraph = join " ", split /^/, $paragraph;
-
- # Matches something that looks like a file name, but is enclosed in
- # C<...>
- my $C_path_re = qr{ \b ( C<
- # exclude various things that have slashes
- # in them but aren't paths
- (?!
- (?: (?: s | qr | m) / ) # regexes
- | \d+/\d+> # probable fractions
- | OS/2>
- | Perl/Tk>
- | origin/blead>
- | origin/maint
- | - # File names don't begin with "-"
- )
- [-\w]+ (?: / [-\w]+ )+ (?: \. \w+ )? > )
- }x;
-
- # If looks like a reference to other documentation by containing the
- # word 'See' and then a likely pod directive, warn.
- while ($paragraph =~ m{
+
+ return $self->SUPER::end_over(@_);
+ }
+
+ # Matches something that looks like a file name, but is enclosed in
+ # C<...>
+ my $C_path_re = qr{ ^
+ # exclude various things that have slashes
+ # in them but aren't paths
+ (?!
+ (?: (?: s | qr | m) / ) # regexes
+ | \d+/\d+ \b # probable fractions
+ | (?: [LF] < )+
+ | OS/2 \b
+ | Perl/Tk \b
+ | origin/blead \b
+ | origin/maint \b
+ )
+ /? # Optional initial slash
+ \w+ # First component of path, doesn't begin with
+ # a minus
+ (?: / [-\w]+ )+ # Subsequent path components
+ (?: \. \w+ )? # Optional trailing dot and suffix
+ >* # Any enclosed L< F< have matching closing >
+ $
+ }x;
+
+ sub check_see_but_not_link {
+
+ # Looks through accumulated text for current element that includes the
+ # C<>, F<>, and L<> directives for ones that look like they are
+ # C<link> instead of L<link>.
+
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ return unless defined $running_CFL_text{$addr};
+
+ while ($running_CFL_text{$addr} =~ m{
( (?: \w+ \s+ )* ) # The phrase before, if any
\b [Ss]ee \s+
( ( [^L] )
@@ -829,7 +948,8 @@ package My::Pod::Checker { # Extend Pod::Checker
>
)
( \s+ (?: under | in ) \s+ L< )?
- }xg) {
+ }xg)
+ {
my $prefix = $1 // "";
my $construct = $2; # The whole thing, like C<...>
my $type = $3;
@@ -846,25 +966,13 @@ package My::Pod::Checker { # Extend Pod::Checker
# construct would be if it actually has L<> syntax. If it
# doesn't have that syntax, will set the module to the entire
# interior.
- $interior =~ m/ ^
- (?: [^|]+ \| )? # Optional arbitrary text ending
- # in "|"
- ( .+? ) # module, etc. name
- (?: \/ .+ )? # target within module
- $
- /xs;
- my $module = $1;
if (! defined $trailing # not referring to something in another
# section
&& $interior !~ /$non_pods/
- # C<> that look like files have their own message below, so
- # exclude them
- && $construct !~ /$C_path_re/g
-
# There can't be spaces (I think) in module names or man
# pages
- && $module !~ / \s /x
+ && $interior !~ / \s /x
# F<> that end in eg \.pl are almost certainly ok, as are
# those that look like a path with multiple "/" chars
@@ -874,94 +982,212 @@ package My::Pod::Checker { # Extend Pod::Checker
&& $interior !~ /\/.+\//)
)
) {
- $self->poderror({ -line => $line, -file => $file,
+ $self->poderror({ -line => $start_line{$addr},
-msg => $see_not_linked,
parameter => $construct
});
}
}
}
- while ($paragraph =~ m/$C_path_re/g) {
- my $construct = $1;
- $self->poderror({ -line => $line, -file => $file,
- -msg => $C_with_slash,
- parameter => $construct
- });
- }
- return;
+
+ undef $running_CFL_text{$addr};
}
- sub command {
- my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
+ sub end_Para {
+ my $self = shift;
+ check_see_but_not_link($self);
+
my $addr = Scalar::Util::refaddr $self;
- if ($cmd eq "pod") {
- $seen_pod_cmd{$addr}++;
- }
- elsif ($cmd eq "encoding") {
- my ($file, $line) = $pod_para->file_line;
- $seen_encoding_cmd{$addr} = $paragraph; # for later decoding
- if ($command_count{$addr} != 1 && $seen_pod_cmd{$addr}) {
- $self->poderror({ -line => $line, -file => $file,
- -msg => $encoding_first
- });
+ if ($in_NAME{$addr}) {
+ # XXX check for multiple NAME, or does parent do it ?
+ if ($running_simple_text{$addr} =~ /^\s*(\S+?)\s*$/) {
+ $self->poderror({ -line => $start_line{$addr},
+ -msg => $missing_name_description,
+ parameter => $1});
}
+ $in_NAME{$addr} = 0;
}
- $self->check_encoding($paragraph, $line_num, $pod_para);
-
- # Pod::Check treats all =items as linkable, but the bullet and
- # numbered lists really aren't. So keep our own list. This has to be
- # processed before SUPER is called so that the list is started before
- # the rest of it gets parsed.
- if ($cmd eq 'item') { # Not linkable if item begins with * or a digit
- $linkable_item{$addr} = ($paragraph !~ / ^ \s*
- (?: [*]
- | \d+ \.? (?: \$ | \s+ )
- )/x)
- ? 1
- : 0;
+ $self->SUPER::end_Para(@_);
+ }
+ sub start_head1 {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ return $self->SUPER::start_head1(@_);
+ }
+
+ sub end_head1 { # This is called at the end of the =head line.
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_NAME{$addr} = 1 if $running_simple_text{$addr} eq 'NAME';
+ return $self->SUPER::end_head(@_);
+ }
+
+ sub start_Verbatim {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $running_simple_text{$addr} = "";
+ $start_line{$addr} = $_[0]->{start_line};
+ return $self->SUPER::start_Verbatim(@_);
+ }
+
+ sub end_Verbatim {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ # Pick up the name if it looks like one, since the parent class
+ # doesn't handle verbatim NAMEs
+ if ($in_NAME{$addr}
+ && $running_simple_text{$addr} =~ /^\s*(\S+?)\s*[,-]/)
+ {
+ $self->name($1);
}
- $self->SUPER::command($cmd, $paragraph, $line_num, $pod_para);
-
- $command_count{$addr}++;
-
- $in_NAME{$addr} = 0; # Will change to 1 below if necessary
- $in_begin{$addr} = 0; # ibid
- if ($cmd eq 'over') {
- my $text = $self->interpolate($paragraph, $line_num);
- my $indent = 4; # default
- $indent = $1 if $text && $text =~ /^\s*(\d+)\s*$/;
- push @{$indents{$addr}}, $indent;
- $current_indent{$addr} += $indent;
- }
- elsif ($cmd eq 'back') {
- if (@{$indents{$addr}}) {
- $current_indent{$addr} -= pop @{$indents{$addr}};
- }
- else {
- # =back without corresponding =over, but should have
- # warned already
- $current_indent{$addr} = 0;
- }
- }
- elsif ($cmd =~ /^head/) {
- if (! $in_begin{$addr}) {
- # If a particular formatter, then this command doesn't really
- # apply
- $current_indent{$addr} = 0;
- undef @{$indents{$addr}};
- }
+ my $indent = $self->get_current_indent;
+
+ # Look at each line to verify it is short enough
+ my @lines = split /^/, $running_simple_text{$addr};
+ for my $i (0 .. @lines - 1) {
+ $lines[$i] =~ s/\s+$//;
+ my $exceeds = length(Text::Tabs::expand($lines[$i]))
+ + $indent - $MAX_LINE_LENGTH;
+ next unless $exceeds > 0;
- my $text = $self->interpolate($paragraph, $line_num);
- $in_NAME{$addr} = 1 if $cmd eq 'head1'
- && $text && $text =~ /^NAME\b/;
+ $self->poderror({ -line => $start_line{$addr} + $i,
+ -msg => $line_length,
+ parameter => "+$exceeds (including " . ($indent - $INDENT) . " from =over's)",
+ });
}
- elsif ($cmd eq 'begin') {
- $in_begin{$addr} = 1;
+
+ undef $running_simple_text{$addr};
+
+ # Parent class didn't bother to define this
+ #return $self->SUPER::SUPER::end_Verbatim(@_);
+ }
+
+ sub start_C {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $C_text{$addr} = "";
+
+ # If not in a stacked set of C<>, F<> and L<>, initialize the text for
+ # them.
+ $CFL_text{$addr} = "" if ! $in_CFL{$addr};
+ $in_CFL{$addr}++;
+
+ return $self->SUPER::start_C(@_);
+ }
+
+ sub start_F {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "" if ! $in_CFL{$addr};
+ $in_CFL{$addr}++;
+ return $self->SUPER::start_F(@_);
+ }
+
+ sub start_L {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "" if ! $in_CFL{$addr};
+ $in_CFL{$addr}++;
+ return $self->SUPER::start_L(@_);
+ }
+
+ sub end_C {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ # Warn if looks like a file or link enclosed instead by this C<>
+ if ($C_text{$addr} =~ qr/^ $C_path_re $/x) {
+ $self->poderror({ -line => $start_line{$addr},
+ -msg => $C_with_slash,
+ parameter => "C<$C_text{$addr}>"
+ });
}
+ undef $C_text{$addr};
+
+ # Add the current text to the running total. This was not done in
+ # handle_text(), because it just sees the plain text of the innermost
+ # stacked directive. We want to keep all the directive names
+ # enclosing the text. Otherwise the fact that C<L<foobar>> is to a
+ # link would be lost, as the L<> would be gone.
+ $CFL_text{$addr} = "C<$CFL_text{$addr}>";
+
+ # Add this text to the the whole running total only if popping this
+ # directive off the stack leaves it empty. As long as something is on
+ # the stack, it gets added to $CFL_text (just above). It is only
+ # entirely constructed when the stack is empty.
+ $in_CFL{$addr}--;
+ $running_CFL_text{$addr} .= $CFL_text{$addr} if ! $in_CFL{$addr};
+
+ return $self->SUPER::end_C(@_);
+ }
- return;
+ sub end_F {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "F<$CFL_text{$addr}>";
+ $in_CFL{$addr}--;
+ $running_CFL_text{$addr} .= $CFL_text{$addr} if ! $in_CFL{$addr};
+ return $self->SUPER::end_F(@_);
+ }
+
+ sub end_L {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "L<$CFL_text{$addr}>";
+ $in_CFL{$addr}--;
+ $running_CFL_text{$addr} .= $CFL_text{$addr} if ! $in_CFL{$addr};
+ return $self->SUPER::end_L(@_);
+ }
+
+ sub start_X {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_X{$addr} = 1;
+ return $self->SUPER::start_X(@_);
+ }
+
+ sub end_X {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_X{$addr} = 0;
+ return $self->SUPER::end_X(@_);
+ }
+
+ sub start_for {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_for{$addr} = 1;
+ return $self->SUPER::start_for(@_);
+ }
+
+ sub end_for {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_for{$addr} = 0;
+ return $self->SUPER::end_for(@_);
}
sub hyperlink {
@@ -969,7 +1195,7 @@ package My::Pod::Checker { # Extend Pod::Checker
my $page;
if ($_[0] && ($page = $_[0][1]{'-page'})) {
- my $node = $_[0][1]{'-node'};
+ my $node = $_[0][1]->node;
# If the hyperlink is to an interior node of another page, save it
# so that we can see if we need to parse normally skipped files.
@@ -1237,6 +1463,7 @@ sub extract_pod { # Extracts just the pod from a file
# unlikely event.
or die "Can't open '$filename': $!\n";
+ use Pod::Parser;
my $parser = Pod::Parser->new();
$parser->parse_from_filehandle($in_fh, *ALREADY_FH);
close $in_fh;
@@ -1267,7 +1494,7 @@ sub is_pod_file {
note("Not considering $_") if DEBUG;
return;
}
-
+
my $filename = $File::Find::name;
# Assumes that the path separator is exactly one character.
@@ -1557,6 +1784,7 @@ foreach my $filename (@files) {
$checker->set_skip("$filename dependent on component pods");
}
else {
+ #XXX shouldn't do with specific input files
croak("Unexpected file '$filename' encountered that has parsing for interior-linking only");
}
@@ -1619,6 +1847,9 @@ if (! $has_input_files) {
my $linked_to_page = $link->[1]->page;
next unless $linked_to_page; # intra-file checks are handled by std
# Pod::Checker
+ # We don't currently XXX check the validity of these
+ next if $linked_to_page
+ =~ /^ (?: ftp | http s? | irc | mailto | news ) :/x;
# Initialize the potential message.
my %problem = ( -msg => $broken_link,