path: root/cpan/Pod-Parser/lib/Pod/Checker.pm

#############################################################################
# Pod/Checker.pm -- check pod documents for syntax errors
#
# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::Checker;
use strict;
use warnings;
use Data::Dumper

our $VERSION = '1.45';  ## Current version of this package
use 5.14.0;

use Pod::ParseUtils; ## for hyperlinks and lists

=head1 NAME

Pod::Checker, podchecker() - check pod documents for syntax errors

=head1 SYNOPSIS

  use Pod::Checker;

  $syntax_okay = podchecker($filepath, $outputpath, %options);

  my $checker = Pod::Checker->new(%options);
  $checker->parse_from_file($filepath, \*STDERR);

=head1 OPTIONS/ARGUMENTS

C<$filepath> is the input POD to read and C<$outputpath> is
where to write POD syntax error messages. Either argument may be a scalar
indicating a file-path, or else a reference to an open filehandle.
If unspecified, the input-file it defaults to C<\*STDIN>, and
the output-file defaults to C<\*STDERR>.

=head2 podchecker()

This function can take a hash of options:

=over 4

=item B<-warnings> =E<gt> I<val>

Turn warnings on/off. I<val> is usually 1 for on, but higher values
trigger additional warnings. See L<"Warnings">.

=item B<-quiet> =E<gt> I<val>

If C<num> is true, do not print any errors/warnings.

=back

=head1 DESCRIPTION

B<podchecker> will perform syntax checking of Perl5 POD format documentation.

Curious/ambitious users are welcome to propose additional features they wish
to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
consistent with L<perlpod>.

The following checks are currently performed:

=over 4

=item *

Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences,
and unterminated interior sequences.

=item *

Check for proper balancing of C<=begin> and C<=end>. The contents of such
a block are generally ignored, i.e. no syntax checks are performed.

=item *

Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.

=item *

Check for same nested interior-sequences (e.g.
C<LE<lt>...LE<lt>...E<gt>...E<gt>>).

=item *

Check for malformed or non-existing entities C<EE<lt>...E<gt>>.

=item *

Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod>
for details.

=item *

Check for unresolved document-internal links. This check may also reveal
misspelled links that seem to be internal links but should be links
to something else.

=back

=head1 DIAGNOSTICS

=head2 Errors

=over 4

=item * empty =headn

A heading (C<=head1> or C<=head2>) without any text? That ain't no
heading!

=item * =over on line I<N> without closing =back

=item * You forgot a '=back' before '=headI<N>'

=item * =over is the last thing in the document?!

The C<=over> command does not have a corresponding C<=back> before the
next heading (C<=head1> or C<=head2>) or the end of the file.

=item * '=item' outside of any '=over'

=item * =back without =over

An C<=item> or C<=back> command has been found outside a
C<=over>/C<=back> block.

=item * Can't have a 0 in =over I<N>

You need to indent a strictly positive number of spaces, not 0.

=item * =over should be: '=over' or '=over positive_number'

Either have an argumentless =over, or have its argument a strictly positive number.

=item * =begin I<TARGET> without matching =end I<TARGET>

A C<=begin> command was found that has no matching =end command.

=item * =begin without a target?

A C<=begin> command was found that is not followed by the formatter
specification.

=item * =end I<TARGET> without matching =begin.

A standalone C<=end> command was found.

=item * '=end' without a target?

'=end' directives need to have a target, just like =begin directives.

=item * '=end I<TARGET>' is invalid.

I<TARGET> needs to be one word

=item * =end I<TARGET> doesn't match =begin.

I<TARGET> needs to match =begin's target

=item * =for without a target?

There is no specification of the formatter after the C<=for> command.

=item * unresolved internal link I<NAME>

The given link to I<NAME> does not have a matching node in the current
POD. This also happened when a single word node name is not enclosed in
C<"">.

=item * Unknown directive: I<CMD>

An invalid POD command has been found. Valid are C<=head1>, C<=head2>,
C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>,
C<=for>, C<=pod>, C<=cut>

=item * Deleting unknown formatting code I<SEQ>

An invalid markup command has been encountered. Valid are:
C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>,
C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>,
C<ZE<lt>E<gt>>

=item * Unterminated I<SEQ>E<lt>E<gt> sequence

An unclosed formatting code

=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt>

Two nested identical markup commands have been found. Generally this
does not make sense.

=item * An EE<lt>...E<gt> surrounding strange content

The I<STRING> found cannot be interpreted as a character entity.

=item * An empty L<>

There needs to be content inside an L<> formatting code.

=item * A non-empty ZE<lt>E<gt>

The C<ZE<lt>E<gt>> sequence is supposed to be empty.

=item * An empty XE<lt>E<gt>

The index entry specified contains nothing but whitespace.

=item * Spurious text after =pod / =cut

The commands C<=pod> and C<=cut> do not take any arguments.

=item * =back doesn't take any parameters, but you said =back I<ARGUMENT>

The C<=back> command does not take any arguments.

=item * =pod directives shouldn't be over one line long!  Ignoring all I<N> lines of content

Self explanatory

=item * =cut found outside a pod block.

A '=cut' directive found in the middle of non-POD

=item * Invalid =encoding syntax: I<CONTENT>

Syntax error in =encoding directive

=back

=head2 Warnings

These may not necessarily cause trouble, but indicate mediocre style.

=over 4

=item * multiple occurrence of link target I<name>

The POD file has some C<=item> and/or C<=head> commands that have
the same text. Potential hyperlinks to such a text cannot be unique then.
This warning is printed only with warning level greater than one.

=item * line containing nothing but whitespace in paragraph

There is some whitespace on a seemingly empty line. POD is very sensitive
to such things, so this is flagged. B<vi> users switch on the B<list>
option to avoid this problem.

=item * =item has no contents

There is a list C<=item> that has no text contents. You probably want to delete
empty items.

=item * You can't have =items (as at line I<N>) unless the first thing after the =over is an =item

A list introduced by C<=over> starts with a text or verbatim paragraph,
but continues with C<=item>s. Move the non-item paragraph out of the
C<=over>/C<=back> block.

=item * Expected '=item I<EXPECTED VALUE>'

=item * Expected '=item *'

=item * Possible =item type mismatch: 'I<x>' found leading a supposed definition =item

A list started with e.g. a bullet-like C<=item> and continued with a
numbered one. This is obviously inconsistent. For most translators the
type of the I<first> C<=item> determines the type of the list.

=item * You have '=item x' instead of the expected '=item I<N>'

Erroneous numbering of =item numbers; they need to ascend consecutively.

=item * I<N> unescaped C<E<lt>E<gt>> in paragraph

Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>>
can potentially cause errors as they could be misinterpreted as
markup commands. This is only printed when the -warnings level is
greater than 1.

=item * Unknown E content in EE<lt>I<CONTENT>E<gt>

A character entity was found that does not belong to the standard
ISO set or the POD specials C<verbar> and C<sol>. I<Currently, this warning
only appears if a character entity was found that does not have a Unicode
character. This should be fixed to adhere to the original warning.>

=item * empty =over/=back block

The list opened with C<=over> does not contain anything.

=item * empty section in previous paragraph

The previous section (introduced by a C<=head> command) does not contain
any text. This usually indicates that something is missing. Note: A
C<=head1> followed immediately by C<=head2> does not trigger this warning.

=item * Verbatim paragraph in NAME section

The NAME section (C<=head1 NAME>) should consist of a single paragraph
with the script/module name, followed by a dash `-' and a very short
description of what the thing is good for.

=item * =headI<n> without preceding higher level

For example if there is a C<=head2> in the POD file prior to a
C<=head1>.

=back

=head2 Hyperlinks

There are some warnings with respect to malformed hyperlinks:

=over 4

=item * ignoring leading/trailing whitespace in link

There is whitespace at the beginning or the end of the contents of
LE<lt>...E<gt>.

=item * alternative text/node '%s' contains non-escaped | or /

The characters C<|> and C</> are special in the LE<lt>...E<gt> context.
Although the hyperlink parser does its best to determine which "/" is
text and which is a delimiter in case of doubt, one ought to escape
these literal characters like this:

  /     E<sol>
  |     E<verbar>

=back

Note that the line number of the error/warning is sometimes off by a few.

=head1 RETURN VALUE

B<podchecker> returns the number of POD syntax errors found or -1 if
there were no POD commands at all found in the file.

=head1 EXAMPLES

See L</SYNOPSIS>

=head1 INTERFACE

While checking, this module collects document properties, e.g. the nodes
for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>).
POD translators can use this feature to syntax-check and get the nodes in
a first pass before actually starting to convert. This is expensive in terms
of execution time, but allows for very robust conversions.

Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>
method to print errors and warnings. The summary output (e.g.
"Pod syntax OK") has been dropped from the module and has been included in
B<podchecker> (the script). This allows users of B<Pod::Checker> to
control completely the output behavior. Users of B<podchecker> (the script)
get the well-known behavior.

=cut

#############################################################################

#use diagnostics;
use Carp qw(croak);
use Exporter 'import';
use base qw/Pod::Simple::Methody/;

our @EXPORT = qw(&podchecker);

##---------------------------------
## Function definitions begin here
##---------------------------------

sub podchecker {
    my ($infile, $outfile, %options) = @_;
    local $_;

    ## Set defaults
    $infile  ||= \*STDIN;
    $outfile ||= \*STDERR;

    ## Now create a pod checker
    my $checker = Pod::Checker->new(%options);

    ## Now check the pod document for errors
    $checker->parse_from_file($infile, $outfile);

    ## Return the number of errors found
    return $checker->num_errors();
}


##---------------------------------------------------------------------------

##-------------------------------
## Method definitions begin here
##-------------------------------

##################################

=over 4

=item C<Pod::Checker-E<gt>new( %options )>

Return a reference to a new Pod::Checker object that inherits from
Pod::Simple and is used for calling the required methods later. The
following options are recognized:

C<-warnings =E<gt> num>
  Print warnings if C<num> is true. The higher the value of C<num>,
the more warnings are printed. Currently there are only levels 1 and 2.

C<-quiet =E<gt> num>
  If C<num> is true, do not print any errors/warnings. This is useful
when Pod::Checker is used to munge POD code into plain text from within
POD formatters.

=cut

sub new {
    my $new = shift->SUPER::new(@_);
    $new->{'output_fh'} ||= *STDERR{IO};

    # Set options
    my %opts = @_;
    $new->{'-warnings'} = defined $opts{'-warnings'} ?
                                  $opts{'-warnings'} : 1; # default on
    $new->{'-quiet'} = $opts{'-quiet'} || 0; # default off

    # Initialize number of errors/warnings
    $new->{'_NUM_ERRORS'} = 0;
    $new->{'_NUM_WARNINGS'} = 0;

    # 'current' also means 'most recent' in the follow comments
    $new->{'_thispara'} = '';       # current POD paragraph
    $new->{'_line'} = 0;            # current line number
    $new->{'_head_num'} = 0;        # current =head level (set to 0 to make
                                    #   logic easier down the road)
    $new->{'_cmds_since_head'} = 0; # num of POD directives since prev. =headN
    $new->{'_nodes'} = [];          # stack for =head/=item nodes
    $new->{'_list_stack'} = [];     # stack for nested lists
    $new->{'_fcode_stack'} = [];    # stack for nested formatting codes
    $new->{'_fcode_pos'} = [];      # stack for position in paragraph of fcodes
    $new->{'_begin_stack'} = [];    # stack for =begins: [line #, target]
    $new->{'_links'} = [];          # stack for internal hyperlinks
    $new->{'_index'} = [];          # stack for text in X<>s

    $new->accept_targets('*'); # check all =begin/=for blocks
    $new->cut_handler( \&handle_pod_and_cut ); # warn if text after =cut
    $new->pod_handler( \&handle_pod_and_cut ); # warn if text after =pod
    $new->whiteline_handler( \&handle_whiteline ); # warn if whiteline
    $new->parse_empty_lists(1); # warn if they are empty

    return $new;
}

##################################

=item C<$checker-E<gt>poderror( @args )>

=item C<$checker-E<gt>poderror( {%opts}, @args )>

Internal method for printing errors and warnings. If no options are given,
simply prints "@_". The following options are recognized and used to form
the output:

  -msg

A message to print prior to C<@args>.

  -line

The line number the error occurred in.

  -file

The file (name) the error occurred in. Defaults to the name of the current
file being processed.

  -severity

The error level, should be 'WARNING' or 'ERROR'.

=cut

# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
sub poderror {
    my $self = shift;
    my %opts = (ref $_[0]) ? %{shift()} : ();

    ## Retrieve options
    chomp( my $msg  = ($opts{'-msg'} || '')."@_" );
    my $line = (exists $opts{'-line'}) ? " at line $opts{'-line'}" : '';
    my $file = ' in file ' . ((exists $opts{'-file'}) ?
                             $opts{'-file'} : $self->source_filename);
    unless (exists $opts{'-severity'}) {
       ## See if can find severity in message prefix
       $opts{'-severity'} = $1  if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// );
    }
    my $severity = (exists $opts{'-severity'}) ? "*** $opts{-severity}: " : '';

    ## Increment error count and print message "
    ++($self->{'_NUM_ERRORS'})
        if(!%opts || ($opts{-severity} && $opts{'-severity'} eq 'ERROR'));
    ++($self->{'_NUM_WARNINGS'})
        if(!%opts || ($opts{-severity} && $opts{'-severity'} eq 'WARNING'));
    unless($self->{'-quiet'}) {
      my $out_fh = $self->{'output_fh'} || \*STDERR;
      print $out_fh ($severity, $msg, $line, $file, "\n")
        if($self->{'-warnings'} || !%opts || $opts{'-severity'} ne 'WARNING');
    }
}

##################################

=item C<$checker-E<gt>num_errors()>

Set (if argument specified) and retrieve the number of errors found.

=cut

sub num_errors {
   return (@_ > 1) ? ($_[0]->{'_NUM_ERRORS'} = $_[1]) : $_[0]->{'_NUM_ERRORS'};
}

##################################

=item C<$checker-E<gt>num_warnings()>

Set (if argument specified) and retrieve the number of warnings found.

=cut

sub num_warnings {
   return (@_ > 1) ? ($_[0]->{'_NUM_WARNINGS'} = $_[1]) :
                      $_[0]->{'_NUM_WARNINGS'};
}

##################################

=item C<$checker-E<gt>name()>

Set (if argument specified) and retrieve the canonical name of POD as
found in the C<=head1 NAME> section.

=cut

sub name {
    return (@_ > 1 && $_[1]) ?
        ($_[0]->{'_pod_name'} = $_[1]) : $_[0]->{'_pod_name'};
}

##################################

=item C<$checker-E<gt>node()>

Add (if argument specified) and retrieve the nodes (as defined by C<=headX>
and C<=item>) of the current POD. The nodes are returned in the order of
their occurrence. They consist of plain text, each piece of whitespace is
collapsed to a single blank.

=cut

sub node {
    my ($self,$text) = @_;
    if(defined $text) {
        $text =~ s/\s+/ /gs; # collapse whitespace
        # add node, order important!
        push(@{$self->{'_nodes'}}, $text);
        # keep also a uniqueness counter
        $self->{'_unique_nodes'}->{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self->{'_nodes'}};
}

##################################

=item C<$checker-E<gt>idx()>

Add (if argument specified) and retrieve the index entries (as defined by
C<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece
of whitespace is collapsed to a single blank.

=cut

# set/return index entries of current POD
sub idx {
    my ($self,$text) = @_;
    if(defined $text) {
        $text =~ s/\s+/ /gs; # collapse whitespace
        # add node, order important!
        push(@{$self->{'_index'}}, $text);
        # keep also a uniqueness counter
        $self->{'_unique_nodes'}->{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self->{'_index'}};
}

##################################

=item C<$checker-E<gt>hyperlink()>

Add (if argument specified) and retrieve the hyperlinks (as defined by
C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line
number and C<Pod::Hyperlink> object.

=back

=cut

# set/return hyperlinks of the current POD
sub hyperlink {
    my $self = shift;
    if($_[0]) {
        push(@{$self->{'_links'}}, $_[0]);
        return $_[0];
    }
    @{$self->{'_links'}};
}

##################################

# override Pod::Simple's whine() and scream() to use poderror()

# Note:
# Ignore $self->{'no_whining'} b/c $self->{'quiet'} takes care of it in poderror
# Don't bother incrementing $self->{'errors_seen'} -- it's not used
# Don't bother pushing to $self->{'errata'} b/c poderror() outputs immediately
# We don't need to set $self->no_errata_section(1) b/c of these overrides


sub whine {
    my ($self, $line, $complaint) = @_;

    # Convert errors in Pod::Simple that are warnings in Pod::Checker
    # XXX Do differently so the $complaint can be reworded without this breaking
    my $severity = 'ERROR';
    $severity = 'WARNING' if
        $complaint =~ /^Expected '=item .+?'$/ ||
        $complaint =~ /^You can't have =items \(as at line .+?\) unless the first thing after the =over is an =item$/ ||
        $complaint =~ /^You have '=item .+?' instead of the expected '=item .+?'$/;

    $self->poderror({ -line => $line,
                      -severity => $severity,
                      -msg => $complaint });

    return 1; # assume everything is peachy keen
}

sub scream {
    my ($self, $line, $complaint) = @_;

    $self->poderror({ -line => $line,
                      -severity => 'ERROR', # consider making severity 'FATAL'
                      -msg => $complaint });

    return 1;
}


##################################

# Some helper subroutines

sub _init_event { # assignments done at the start of most events
    $_[0]{'_thispara'} = '';
    $_[0]{'_line'} = $_[1]{'start_line'};
    $_[0]{'_cmds_since_head'}++;
}

sub _open_list { # keep track of =open/=back blocks
    my ($self, $indent, $line, $type, $file) = @_;
    my $list = Pod::List->new(
        -indent => $indent,
        -start  => $line,
        -type   => $type,
        -file   => $file // $self->source_filename);
    unshift (@{$self->{'_list_stack'}}, $list);
    $list;
}

sub _close_list { shift @{shift->{'_list_stack'}} }

sub _check_fcode {
    my ($self, $inner, $outers) = @_;
    # Check for an fcode inside another of the same fcode
    if ($inner ~~ $outers) {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => "nested commands $inner<...$inner<...>...>"});
    }
}

sub _check_angles {
    my ($self, $text) = @_;
    return unless $self->{'-warnings'} > 1;

    state $line = '';
    state $line_num;
    if ($line eq substr($text, 0, length $line)) {
        # only check line segments we have not seen yet
        $line = $text;
        $line_num = $self->{'_line'}; # note the line we are processing
    } else {
        if (my $count = $text =~ tr/<>/<>/) {
            $self->poderror({ -line => $line_num,
                              -severity => 'WARNING',
                              -msg => "$count unescaped <> in paragraph" });
        }
        $line = '';
    }
}

##################################

sub handle_text { $_[0]->_check_angles($_[0]{'_thispara'} .= $_[1]) }

# whiteline is a seemingly blank line that matches /[\t ]/
sub handle_whiteline {
    my ($line, $line_n, $self) = @_;
    $self->poderror({
        -line => $line_n,
        -severity => 'WARNING',
        -msg => 'line containing nothing but whitespace in paragraph'});
}

######## Directives
sub handle_pod_and_cut {
    my ($line, $line_n, $self) = @_;
    $self->{'_cmds_since_head'}++;
    if ($line =~ /=(pod|cut)\s+\S/) {
        $self->poderror({ -line => $line_n,
                          -severity => 'ERROR',
                          -msg => "Spurious text after =$1"});
    }
}

sub start_Para { shift->_init_event(@_); }
sub end_Para   {
    my $self = shift;
    # Get the NAME of the pod document
    if ($self->{'_head_num'} == 1 && $self->{'_head_text'} eq 'NAME') {
        if ($self->{'_thispara'} =~ /^\s*(\S+?)\s*[,-]/) {
            $self->{'_pod_name'} = $1 unless defined $self->{'_pod_name'};
        }
    }
}

sub start_Verbatim {
    my $self = shift;
    $self->_init_event(@_);

    if ($self->{'_head_num'} == 1 && $self->{'_head_text'} eq 'NAME') {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => 'Verbatim paragraph in NAME section' });
    }
}
# Don't need an end_Verbatim

# Do I need to do anything else with this?
sub start_Data { shift->_init_event() }

sub start_head1 { shift->start_head(1, @_) }
sub start_head2 { shift->start_head(2, @_) }
sub start_head3 { shift->start_head(3, @_) }
sub start_head4 { shift->start_head(4, @_) }
sub start_head  {
    my $self = shift;
    my $h = shift;
    $self->_init_event(@_);
    my $prev_h = $self->{'_head_num'};
    $self->{'_head_num'} = $h;
    $self->{"_count_head$h"}++;

    if ($h > 1 && !$self->{'_count_head'.($h-1)}) {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => "=head$h without preceding higher level"});
    }

    # If this is the first =head of the doc, $prev_h is 0, thus less than $h
    if ($self->{'_cmds_since_head'} == 1 && $prev_h >= $h) {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => 'empty section in previous paragraph'});
    }
}

sub end_head1 { shift->end_head(@_) }
sub end_head2 { shift->end_head(@_) }
sub end_head3 { shift->end_head(@_) }
sub end_head4 { shift->end_head(@_) }
sub end_head  {
    my $self = shift;
    my $arg = $self->{'_head_text'} = $self->{'_thispara'};
    $self->{'_cmds_since_head'} = 0;
    my $h = $self->{'_head_num'};

    #warn $arg;

    # XXX Fcodes have their content extracted and placed in $arg.
    # This is bad news for X<...>, as that should not be visible
    # also, L<>s should be formatted differently 
    # splice '_thispara' in end_X maybe
    # OR, have each fcode generate text (L would be 'Y in Z')
    #  and X would be '', and use that to make up _thispara
    # test this in podchkinter.t
    $self->node($arg); # remember this node

    if ($arg eq '') {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'ERROR',
                          -msg => "empty head$h" });
    }
}

sub start_over_bullet { shift->start_over(@_, 'bullet') }
sub start_over_number { shift->start_over(@_, 'number') }
sub start_over_text   { shift->start_over(@_, 'definition') }
sub start_over_block  { shift->start_over(@_, 'block') }
sub start_over_empty  {
    my $self = shift;
    $self->start_over(@_, 'empty');
    $self->poderror({ -line => $self->{'_line'},
                      -severity => 'WARNING',
                      -msg => 'empty =over/=back block' });
}
sub start_over {
    my $self = shift;
    my $type = pop;
    $self->_init_event(@_);
    $self->_open_list($_[1]{'indent'}, $self->{'_line'}, $type);
}
sub end_over_bullet { shift->end_over(@_) }
sub end_over_number { shift->end_over(@_) }
sub end_over_text   { shift->end_over(@_) }
sub end_over_block  { shift->end_over(@_) }
sub end_over_empty  { shift->end_over(@_) }
sub end_over {
    my ($self, $flags) = @_;
    if ($flags->{'fake-closer'}) { # meaning Pod::Simple generated this =back
        my $line = $self->{'_list_stack'}[0]->start();
        $self->poderror({ -line => 'EOF',
                          -severity => 'ERROR',
                          -msg => "=over on line $line without closing =back"});
    }
    $self->_close_list();
}

sub start_item_bullet { shift->_init_event(@_) }
sub start_item_number { shift->_init_event(@_) }
sub start_item_text   { shift->_init_event(@_) }
sub end_item_bullet { shift->end_item('bullet') }
sub end_item_number { shift->end_item('number') }
sub end_item_text   { shift->end_item('definition') }
sub end_item {
    my $self = shift;
    my $type = shift;
    if (!$self->{'_thispara'}) {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => '=item has no contents' });
    }

    # warn if type is of definition but content starts with digit or '*'
    # the other cases are taken care of in Pod::Simple
    if ($type eq 'definition' && $self->{'_thispara'} =~ /^([*\d])/) {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => "Possible =item type mismatch: '$1' found ".
                              "leading a supposed definition =item" });
    }

    my $list = $self->{'_list_stack'}->[0];
    $list->item($self->{'_thispara'}); # add item to list
    # XXX compare new pod::checker interface to old one
    # specifically, are there leading *s and numbers in item()s?

    $self->node($self->{'_thispara'}); # remember this node
}

sub start_for { # =for and =begin directives
    my ($self, $flags) = @_;
    $self->_init_event($flags);
    push $self->{'_begin_stack'}, [$self->{'_line'}, $flags->{'target'}];
}

sub end_for {
    my ($self, $flags) = @_;
    my ($line, $target) = @{pop $self->{'_begin_stack'}};
    if ($flags->{'fake-closer'}) { # meaning Pod::Simple generated this =end
        $self->poderror({ -line => $line,
                          -severity => 'ERROR',
                          -msg => "=begin $target without matching =end $target"
                        });
    }
}

sub end_Document {
    # Some final error checks
    my $self = shift;

    # no POD found here
    $self->num_errors(-1) && return unless $self->content_seen;

    my %nodes;
    $nodes{$_}++ for $self->node();
    # XXX Pod::Checker did something if node had whitespace, or if node was idx
    #     -- do I need that here?

    # XXX will $link->node() and $self->node() be E<> escaped, etc?

    # XXX update unresolved internal link POD -- single word not enclosed in ""?

    for ($self->hyperlink()) {
        my ($line, $link) = @$_;
        # XXX What if there is a link to the page by the name
        # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">
        if ($link->node() && !$link->page()
            && $link->type() ne 'hyperlink'
            && !$nodes{$link->node()}) {
              $self->poderror({ -line => $line || '',
                                -severity => 'ERROR',
                                -msg => "unresolved internal link '".
                                    $link->node() ."'"});
        }
    }

    if ($self->{'-warnings'} > 1 ) {
        while (my ($node, $count) = each $self->{'_unique_nodes'}) {
            if ($count > 1) { # not unique
                $self->poderror({
                    -line => '-',
                    -severity => 'WARNING',
                    -msg => "multiple occurrences ($count) of link target ".
                        "'$node'"});
            }
        }
    }
}

########  Formatting codes

sub start_B { shift->start_fcode('B') }
sub start_C { shift->start_fcode('C') }
sub start_F { shift->start_fcode('F') }
sub start_I { shift->start_fcode('I') }
sub start_S { shift->start_fcode('S') }
sub start_fcode {
    my ($self, $fcode) = @_;
    unshift $self->{'_fcode_stack'}, $fcode;
}

sub end_B { shift->end_fcode() }
sub end_C { shift->end_fcode() }
sub end_F { shift->end_fcode() }
sub end_I { shift->end_fcode() }
sub end_S { shift->end_fcode() }
sub end_fcode {
    my $self = shift;
    $self->_check_fcode(shift $self->{'_fcode_stack'}, # current fcode removed
                        $self->{'_fcode_stack'}); # previous fcodes
}

sub start_L {
    my ($self, $flags) = @_;
    $self->start_fcode('L');

    # We use Pod::Hyperlink to parse the raw L<> contents into the -alttext,
    # -page, and -node, but we then use Pod::Simple's parsing to override -page
    # and -node as Pod::Simple handles them better. An example of this is the
    # handling of leading/trailing whitespace: Pod::Simple correctly interprets
    # leading/trailing whitespace to mean the contents are a section, whereas
    # Pod::Hyperlink removes the whitespace and treats the contents as a page.
    # Note that we also use Pod::Hyperlink to issue some L<> error checks.

    my $link = Pod::Hyperlink->new($flags->{'raw'});
    foreach my $w ($link->warning()) {
        # It has been decided that the following should not be a warning
        # so it is skipped
        next if $w =~ /^\(section\) in '.+' deprecated$/;
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'WARNING',
                          -msg => $w });
    }
    $link->page($flags->{'to'});
    $link->node($flags->{'section'});
    $link->line($self->{'_line'});
    $link->type('hyperlink') if $flags->{'type'} eq 'url';
    $self->hyperlink([$self->{'_line'}, $link]); # remember link
}
sub end_L {
    my $self = shift;
    $self->end_fcode();
}

sub start_X {
    my $self = shift;
    $self->start_fcode('X');
    # keep track of where X<> starts in the paragraph
    # (this is a stack so nested X<>s are handled correctly)
    push $self->{'_fcode_pos'}, length $self->{'_thispara'};
}
sub end_X {
    my $self = shift;
    # extract contents of X<>
    my $x = substr($self->{'_thispara'},
                   pop $self->{'_fcode_pos'}); # start at the beginning of X<>
    unless ($x) {
        $self->poderror({ -line => $self->{'_line'},
                          -severity => 'ERROR',
                          -msg => "An empty X<>" });
    }
    $self->idx($x); # remember this node
    $self->end_fcode();
}


1;

__END__

=head1 AUTHOR

Please report bugs using L<http://rt.cpan.org>.

Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
Marek Rouchal E<lt>marekr@cpan.orgE<gt>,
Marc Green E<lt>marcgreen@cpan.orgE<gt> (port to Pod::Simple)

Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>

=cut