<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#############################################################################
# Pod/Checker.pm -- check pod documents for syntax errors
#
# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.
# This 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;

our $VERSION = '1.75';  ## Current version of this package

=head1 NAME

Pod::Checker - check pod documents for syntax errors

=head1 SYNOPSIS

  use Pod::Checker;

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

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

=head1 OPTIONS/ARGUMENTS

C&lt;$filepath&gt; is the input POD to read and C&lt;$outputpath&gt; 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&lt;\*STDIN&gt;, and
the output-file defaults to C&lt;\*STDERR&gt;.

=head2 podchecker()

This function can take a hash of options:

=over 4

=item B&lt;-warnings&gt; =E&lt;gt&gt; I&lt;val&gt;

Turn warnings on/off. I&lt;val&gt; is usually 1 for on, but higher values
trigger additional warnings. See L&lt;"Warnings"&gt;.

=item B&lt;-quiet&gt; =E&lt;gt&gt; I&lt;val&gt;

If C&lt;val&gt; is true, do not print any errors/warnings.

=back

=head1 DESCRIPTION

B&lt;podchecker&gt; will perform syntax checking of Perl5 POD format documentation.

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

The following checks are currently performed:

=over 4

=item *

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

=item *

Check for proper balancing of C&lt;=begin&gt; and C&lt;=end&gt;. 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&lt;=over&gt;, C&lt;=item&gt; and C&lt;=back&gt;.

=item *

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

=item *

Check for malformed or non-existing entities C&lt;EE&lt;lt&gt;...E&lt;gt&gt;&gt;.

=item *

Check for correct syntax of hyperlinks C&lt;LE&lt;lt&gt;...E&lt;gt&gt;&gt;. See L&lt;perlpod&gt;
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&lt;=head1&gt; or C&lt;=head2&gt;) without any text? That ain't no
heading!

=item * =over on line I&lt;N&gt; without closing =back

=item * You forgot a '=back' before '=headI&lt;N&gt;'

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

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

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

=item * =back without =over

An C&lt;=item&gt; or C&lt;=back&gt; command has been found outside a
C&lt;=over&gt;/C&lt;=back&gt; block.

=item * Can't have a 0 in =over I&lt;N&gt;

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&lt;TARGET&gt; without matching =end I&lt;TARGET&gt;

A C&lt;=begin&gt; command was found that has no matching =end command.

=item * =begin without a target?

A C&lt;=begin&gt; command was found that is not followed by the formatter
specification.

=item * =end I&lt;TARGET&gt; without matching =begin.

A standalone C&lt;=end&gt; command was found.

=item * '=end' without a target?

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

=item * '=end I&lt;TARGET&gt;' is invalid.

I&lt;TARGET&gt; needs to be one word

=item * =end I&lt;CONTENT&gt; doesn't match =begin I&lt;TARGET&gt;

I&lt;CONTENT&gt; needs to match =begin's I&lt;TARGET&gt;.

=item * =for without a target?

There is no specification of the formatter after the C&lt;=for&gt; command.

=item * unresolved internal link I&lt;NAME&gt;

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

=item * Unknown directive: I&lt;CMD&gt;

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

=item * Deleting unknown formatting code I&lt;SEQ&gt;

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

=item * Unterminated I&lt;SEQ&gt;E&lt;lt&gt;E&lt;gt&gt; sequence

An unclosed formatting code

=item * An EE&lt;lt&gt;...E&lt;gt&gt; surrounding strange content

The I&lt;STRING&gt; found cannot be interpreted as a character entity.

=item * An empty EE&lt;lt&gt;E&lt;gt&gt;

=item * An empty C&lt;&lt; LE&lt;lt&gt;E&lt;gt&gt; &gt;&gt;

=item * An empty XE&lt;lt&gt;E&lt;gt&gt;

There needs to be content inside E, L, and X formatting codes.

=item * Spurious text after =pod / =cut

The commands C&lt;=pod&gt; and C&lt;=cut&gt; do not take any arguments.

=item * =back doesn't take any parameters, but you said =back I&lt;ARGUMENT&gt;

The C&lt;=back&gt; command does not take any arguments.

=item * =pod directives shouldn't be over one line long!  Ignoring all I&lt;N&gt; 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&lt;CONTENT&gt;

Syntax error in =encoding directive

=back

=head2 Warnings

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

=over 4

=item * nested commands I&lt;CMD&gt;E&lt;lt&gt;...I&lt;CMD&gt;E&lt;lt&gt;...E&lt;gt&gt;...E&lt;gt&gt;

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

=item * multiple occurrences (I&lt;N&gt;) of link target I&lt;name&gt;

The POD file has some C&lt;=item&gt; and/or C&lt;=head&gt; 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&lt;vi&gt; users switch on the B&lt;list&gt;
option to avoid this problem.

=item * =item has no contents

There is a list C&lt;=item&gt; that has no text contents. You probably want to delete
empty items.

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

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

=item * Expected '=item I&lt;EXPECTED VALUE&gt;'

=item * Expected '=item *'

=item * Possible =item type mismatch: 'I&lt;x&gt;' found leading a supposed definition =item

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

=item * You have '=item x' instead of the expected '=item I&lt;N&gt;'

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

=item * Unknown E content in EE&lt;lt&gt;I&lt;CONTENT&gt;E&lt;gt&gt;

A character entity was found that does not belong to the standard
ISO set or the POD specials C&lt;verbar&gt; and C&lt;sol&gt;. I&lt;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.&gt;

=item * empty =over/=back block

The list opened with C&lt;=over&gt; does not contain anything.

=item * empty section in previous paragraph

The previous section (introduced by a C&lt;=head&gt; command) does not contain
any valid content. This usually indicates that something is missing. Note: A
C&lt;=head1&gt; followed immediately by C&lt;=head2&gt; does not trigger this warning.

=item * Verbatim paragraph in NAME section

The NAME section (C&lt;=head1 NAME&gt;) 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&lt;n&gt; without preceding higher level

For example if there is a C&lt;=head2&gt; in the POD file prior to a
C&lt;=head1&gt;.

=item * A non-empty ZE&lt;lt&gt;E&lt;gt&gt;

The C&lt;ZE&lt;lt&gt;E&lt;gt&gt;&gt; sequence is supposed to be empty. Caveat: this issue is
detected in L&lt;Pod::Simple&gt; and will be flagged as an I&lt;ERROR&gt; by any client
code; any contents of C&lt;ZE&lt;lt&gt;...E&lt;gt&gt;&gt; will be disregarded, anyway.

=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;lt&gt;...E&lt;gt&gt;.

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

The characters C&lt;|&gt; and C&lt;/&gt; are special in the LE&lt;lt&gt;...E&lt;gt&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&lt;sol&gt;
  |     E&lt;verbar&gt;

=back

Note that the line number of the error/warning may refer to the line number of
the start of the paragraph in which the error/warning exists, not the line 
number that the error/warning is on. This bug is present in errors/warnings
related to formatting codes. I&lt;This should be fixed.&gt;

=head1 RETURN VALUE

B&lt;podchecker&gt; 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&lt;/SYNOPSIS&gt;

=head1 SCRIPTS

The B&lt;podchecker&gt; script that comes with this distribution is a lean wrapper
around this module. See the online manual with

  podchecker -help
  podchecker -man

=head1 INTERFACE

While checking, this module collects document properties, e.g. the nodes
for hyperlinks (C&lt;=headX&gt;, C&lt;=item&gt;) and index entries (C&lt;XE&lt;lt&gt;E&lt;gt&gt;&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 v1.24 the B&lt;Pod::Checker&gt; module uses only the B&lt;poderror&gt;
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&lt;podchecker&gt; (the script). This allows users of B&lt;Pod::Checker&gt; to
control completely the output behavior. Users of B&lt;podchecker&gt; (the script)
get the well-known behavior.

v1.45 inherits from L&lt;Pod::Simple&gt; as opposed to all previous versions
inheriting from Pod::Parser. Do B&lt;not&gt; use Pod::Simple's interface when
using Pod::Checker unless it is documented somewhere on this page. I
repeat, DO B&lt;NOT&gt; USE POD::SIMPLE'S INTERFACE.

The following list documents the overrides to Pod::Simple, primarily to
make L&lt;Pod::Coverage&gt; happy:

=over 4

=item end_B

=item end_C

=item end_Document

=item end_F

=item end_I

=item end_L

=item end_Para

=item end_S

=item end_X

=item end_fcode

=item end_for

=item end_head

=item end_head1

=item end_head2

=item end_head3

=item end_head4

=item end_item

=item end_item_bullet

=item end_item_number

=item end_item_text

=item handle_pod_and_cut

=item handle_text

=item handle_whiteline

=item hyperlink

=item scream

=item start_B

=item start_C

=item start_Data

=item start_F

=item start_I

=item start_L

=item start_Para

=item start_S

=item start_Verbatim

=item start_X

=item start_fcode

=item start_for

=item start_head

=item start_head1

=item start_head2

=item start_head3

=item start_head4

=item start_item_bullet

=item start_item_number

=item start_item_text

=item start_over

=item start_over_block

=item start_over_bullet

=item start_over_empty

=item start_over_number

=item start_over_text

=item whine

=back

=cut

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

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

our @EXPORT = qw(&amp;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-&gt;new(%options);

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

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


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

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

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

=over 4

=item C&lt;Pod::Checker-E&lt;gt&gt;new( %options )&gt;

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&lt;-warnings =E&lt;gt&gt; num&gt;
  Print warnings if C&lt;num&gt; is true. The higher the value of C&lt;num&gt;,
the more warnings are printed. Currently there are only levels 1 and 2.

C&lt;-quiet =E&lt;gt&gt; num&gt;
  If C&lt;num&gt; 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-&gt;SUPER::new(@_);
    $new-&gt;{'output_fh'} ||= *STDERR{IO};

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

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

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

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

    return $new;
}

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

=item C&lt;$checker-E&lt;gt&gt;poderror( @args )&gt;

=item C&lt;$checker-E&lt;gt&gt;poderror( {%opts}, @args )&gt;

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&lt;@args&gt;.

  -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-&gt;poderror( @args ), or $self-&gt;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'}
                              : ((defined $self-&gt;source_filename)
                                 ? $self-&gt;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-&gt;{'_NUM_ERRORS'})
        if(!%opts || ($opts{-severity} &amp;&amp; $opts{'-severity'} eq 'ERROR'));
    ++($self-&gt;{'_NUM_WARNINGS'})
        if(!%opts || ($opts{-severity} &amp;&amp; $opts{'-severity'} eq 'WARNING'));
    unless($self-&gt;{'-quiet'}) {
      my $out_fh = $self-&gt;{'output_fh'} || \*STDERR;
      print $out_fh ($severity, $msg, $line, $file, "\n")
        if($self-&gt;{'-warnings'} || !%opts || $opts{'-severity'} ne 'WARNING');
    }
}

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

=item C&lt;$checker-E&lt;gt&gt;num_errors()&gt;

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

=cut

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

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

=item C&lt;$checker-E&lt;gt&gt;num_warnings()&gt;

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

=cut

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

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

=item C&lt;$checker-E&lt;gt&gt;name()&gt;

Set (if argument specified) and retrieve the canonical name of POD as
found in the C&lt;=head1 NAME&gt; section.

=cut

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

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

=item C&lt;$checker-E&lt;gt&gt;node()&gt;

Add (if argument specified) and retrieve the nodes (as defined by C&lt;=headX&gt;
and C&lt;=item&gt;) 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+$//s; # strip trailing whitespace
        $text =~ s/\s+/ /gs; # collapse whitespace
        # add node, order important!
        push(@{$self-&gt;{'_nodes'}}, $text);
        # keep also a uniqueness counter
        $self-&gt;{'_unique_nodes'}-&gt;{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self-&gt;{'_nodes'}};
}

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

=item C&lt;$checker-E&lt;gt&gt;idx()&gt;

Add (if argument specified) and retrieve the index entries (as defined by
C&lt;XE&lt;lt&gt;E&lt;gt&gt;&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+$//s; # strip trailing whitespace
        $text =~ s/\s+/ /gs; # collapse whitespace
        # add node, order important!
        push(@{$self-&gt;{'_index'}}, $text);
        # keep also a uniqueness counter
        $self-&gt;{'_unique_nodes'}-&gt;{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self-&gt;{'_index'}};
}

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

# add a hyperlink to the list of those of the current POD; returns current
# list after the addition has been done
sub hyperlink {
    my $self = shift;
    push(@{$self-&gt;{'_links'}}, $_[0]);
    return $_[0];
}

=item C&lt;$checker-E&lt;gt&gt;hyperlinks()&gt;

Retrieve an array containing the hyperlinks to things outside
the current POD (as defined by C&lt;LE&lt;lt&gt;E&lt;gt&gt;&gt;).

Each is an instance of a class with the following methods:

=cut

sub hyperlinks {
    @{shift-&gt;{'_links'}};
}

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

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

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


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

    my $severity = 'ERROR';

    if (0) {
      # XXX: Let's standardize what's a warning and what's an error.  Let's not
      # move stuff up and down the severity tree.  -- rjbs, 2013-04-12
      # Convert errors in Pod::Simple that are warnings in Pod::Checker
      # XXX Do differently so the $complaint can be reworded without this breaking
      $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 .+?'$/;
    }

    # rt.cpan.org #98326 - errors about Z&lt;&gt; ("non-empty")
    $severity = 'WARNING' if $complaint =~ /\bZ\&lt;\&gt;/;

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

    return 1; # assume everything is peachy keen
}

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

    $self-&gt;poderror({ -line =&gt; $line,
                      -severity =&gt; 'ERROR', # consider making severity 'FATAL'
                      -msg =&gt; $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 _check_fcode {
    my ($self, $inner, $outers) = @_;
    # Check for an fcode inside another of the same fcode
    # XXX line number is the line of the start of the paragraph that the warning
    # is in, not the line that the warning is on. Fix this

    # Later versions of Pod::Simple forbid nested L&lt;&gt;'s
    return if $inner eq 'L' &amp;&amp; $Pod::Simple::VERSION ge '3.33';

    if (grep { $_ eq $inner } @$outers) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{'_line'},
                          -severity =&gt; 'WARNING',
                          -msg =&gt; "nested commands $inner&lt;...$inner&lt;...&gt;...&gt;"});
    }
}

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

sub handle_text { $_[0]{'_thispara'} .= $_[1] }

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

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

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

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

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

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

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

    if ($h &gt; 1 &amp;&amp; !$self-&gt;{'_count_head'.($h-1)}) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{'_line'},
                          -severity =&gt; 'WARNING',
                          -msg =&gt; "=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-&gt;{'_cmds_since_head'} == 1 &amp;&amp; $prev_h &gt;= $h) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{'_line'},
                          -severity =&gt; 'WARNING',
                          -msg =&gt; 'empty section in previous paragraph'});
    }
}

sub end_head1 { shift-&gt;end_head(@_) }
sub end_head2 { shift-&gt;end_head(@_) }
sub end_head3 { shift-&gt;end_head(@_) }
sub end_head4 { shift-&gt;end_head(@_) }
sub end_head  {
    my $self = shift;
    my $arg = $self-&gt;{'_thispara'};
    $arg =~ s/\s+$//;
    $self-&gt;{'_head_text'} = $arg;
    $self-&gt;{'_cmds_since_head'} = 0;
    my $h = $self-&gt;{'_head_num'};
    $self-&gt;node($arg); # remember this node
    if ($arg eq '') {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{'_line'},
                          -severity =&gt; 'ERROR',
                          -msg =&gt; "empty =head$h" });
    }
}

sub start_over_bullet { shift-&gt;start_over(@_, 'bullet') }
sub start_over_number { shift-&gt;start_over(@_, 'number') }
sub start_over_text   { shift-&gt;start_over(@_, 'definition') }
sub start_over_block  { shift-&gt;start_over(@_, 'block') }
sub start_over_empty  {
    my $self = shift;
    $self-&gt;start_over(@_, 'empty');
    $self-&gt;poderror({ -line =&gt; $self-&gt;{'_line'},
                      -severity =&gt; 'WARNING',
                      -msg =&gt; 'empty =over/=back block' });
}
sub start_over {
    my $self = shift;
    my $type = pop;
    $self-&gt;_init_event(@_);
}

sub start_item_bullet { shift-&gt;_init_event(@_) }
sub start_item_number { shift-&gt;_init_event(@_) }
sub start_item_text   { shift-&gt;_init_event(@_) }
sub end_item_bullet { shift-&gt;end_item('bullet') }
sub end_item_number { shift-&gt;end_item('number') }
sub end_item_text   { shift-&gt;end_item('definition') }
sub end_item {
    my $self = shift;
    my $type = shift;
    # If there is verbatim text in this item, it will show up as part of
    # 'paras', and not part of '_thispara'.  If the first para after this is a
    # verbatim one, it actually will be (part of) the contents for this item.
    if (   $self-&gt;{'_thispara'} eq ''
        &amp;&amp; (  ! @{$self-&gt;{'paras'}}
            ||    $self-&gt;{'paras'}[0][0] !~ /Verbatim/i))
    {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{'_line'},
                          -severity =&gt; 'WARNING',
                          -msg =&gt; '=item has no contents' });
    }

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

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

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

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

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

    my %nodes;
    for ($self-&gt;node()) {
        $nodes{$_} = 1;
        if(/^(\S+)\s+\S/) {
            # we have more than one word. Use the first as a node, too.
            # This is used heavily in perlfunc.pod
            $nodes{$1} ||= 2; # derived node
        }
    }
    for ($self-&gt;idx()) {
        $nodes{$_} = 3; # index node
    }

    # XXX update unresolved internal link POD -- single word not enclosed in ""?
    # I don't know what I was thinking when I made the above TODO, and I don't
    # know what it means...

    for my $link (@{ $self-&gt;{'_internal_links'} }) {
        my ($name, $line) = @$link;
        unless ( $nodes{$name} ) {
            $self-&gt;poderror({ -line =&gt; $line,
                              -severity =&gt; 'ERROR',
                              -msg =&gt; "unresolved internal link '$name'"});
        }
    }

    # check the internal nodes for uniqueness. This pertains to
    # =headX, =item and X&lt;...&gt;
    if ($self-&gt;{'-warnings'} &gt; 1 ) {
        for my $node (sort keys %{ $self-&gt;{'_unique_nodes'} }) {
            my $count = $self-&gt;{'_unique_nodes'}{$node};
            if ($count &gt; 1) { # not unique
                $self-&gt;poderror({
                    -line =&gt; '-',
                    -severity =&gt; 'WARNING',
                    -msg =&gt; "multiple occurrences ($count) of link target ".
                        "'$node'"});
            }
        }
    }
}

########  Formatting codes

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

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

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

    my $link = Pod::Checker::Hyperlink-&gt;new($flags, $self);
    if ($link) {
        if (   $link-&gt;type eq 'pod'
            &amp;&amp; $link-&gt;node
                # It's an internal-to-this-page link if no page is given, or
                # if the given one is to our NAME.
            &amp;&amp; (! $link-&gt;page || (   $self-&gt;{'_pod_name'}
                                  &amp;&amp; $link-&gt;page eq $self-&gt;{'_pod_name'})))
        {
            push @{ $self-&gt;{'_internal_links'} }, [ $link-&gt;{'-raw_node'}, $link-&gt;line ];
        }
        else {
            $self-&gt;hyperlink($link);
        }
    }
}

sub end_L {
    my $self = shift;
    $self-&gt;end_fcode();
}

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

package Pod::Checker::Hyperlink;

# This class is used to represent L&lt;&gt; link structures, so that the individual
# elements are easily accessible.  It is based on code in Pod::Hyperlink

sub new {
    my ($class,
        $simple_link,   # The link structure returned by Pod::Simple
        $caller         # The caller class
    ) = @_;

    my $self = +{};
    bless $self, $class;

    $self-&gt;{'-line'} ||= $caller-&gt;{'_line'};
    $self-&gt;{'-type'} ||= $simple_link-&gt;{'type'};
    # preserve raw link text for additional checks
    $self-&gt;{'-raw-link-text'} = (exists $simple_link-&gt;{'raw'})
                                ? "$simple_link-&gt;{'raw'}"
                                : "";
    # Force stringification of page and node.  (This expands any E&lt;&gt;.)
    $self-&gt;{'-page'} = exists $simple_link-&gt;{'to'} ? "$simple_link-&gt;{'to'}" : "";
    $self-&gt;{'-node'} = exists $simple_link-&gt;{'section'} ? "$simple_link-&gt;{'section'}" : "";

    # Save the unmodified node text, as the .t files are expecting the message
    # for internal link failures to include it (hence this preserves backward
    # compatibility).
    $self-&gt;{'-raw_node'} = $self-&gt;{'-node'};

    # Remove leading/trailing white space.  Pod::Simple already warns about
    # these, so if the only error is this, and the link is otherwise correct,
    # only the Pod::Simple warning will be output, avoiding unnecessary
    # confusion.
    $self-&gt;{'-page'} =~ s/ ^ \s+ //x;
    $self-&gt;{'-page'} =~ s/ \s+ $ //x;

    $self-&gt;{'-node'} =~ s/ ^ \s+ //x;
    $self-&gt;{'-node'} =~ s/ \s+ $ //x;

    # Pod::Simple warns about L&lt;&gt; and L&lt; &gt;, but not L&lt;/&gt;
    if ($self-&gt;{'-page'} eq "" &amp;&amp; $self-&gt;{'-node'} eq "") {
        $caller-&gt;poderror({ -line =&gt; $caller-&gt;{'_line'},
                          -severity =&gt; 'WARNING',
                          -msg =&gt; 'empty link'});
        return;
    }

    return $self;
}

=item line()

Returns the approximate line number in which the link was encountered

=cut

sub line {
    return $_[0]-&gt;{-line};
}

=item type()

Returns the type of the link; one of:
C&lt;"url"&gt; for things like
C&lt;http://www.foo&gt;, C&lt;"man"&gt; for man pages, or C&lt;"pod"&gt;.

=cut

sub type {
    return  $_[0]-&gt;{-type};
}

=item page()

Returns the linked-to page or url.

=cut

sub page {
    return $_[0]-&gt;{-page};
}

=item node()

Returns the anchor or node within the linked-to page, or an empty string
(C&lt;""&gt;) if none appears in the link.

=back

=cut

sub node {
    return $_[0]-&gt;{-node};
}

=head1 AUTHOR

Please report bugs using L&lt;http://rt.cpan.org&gt;.

Brad Appleton E&lt;lt&gt;bradapp@enteract.comE&lt;gt&gt; (initial version),
Marek Rouchal E&lt;lt&gt;marekr@cpan.orgE&lt;gt&gt;,
Marc Green E&lt;lt&gt;marcgreen@cpan.orgE&lt;gt&gt; (port to Pod::Simple)
Ricardo Signes E&lt;lt&gt;rjbs@cpan.orgE&lt;gt&gt; (more porting to Pod::Simple)
Karl Williamson E&lt;lt&gt;khw@cpan.orgE&lt;gt&gt; (more porting to Pod::Simple)

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

=cut

1
</pre></body></html>