

<div style='background:#0a0a0a; color:#00ff41; font-family:monospace; padding:20px; max-width:900px; margin:20px auto; border:1px solid #00ff41;'><h2 style='color:#ffcc80;'>✏ EDIT: Checker.pm</h2><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#1a1a1a; color:#00ff41; border:1px solid #00ff41; font-family:monospace; padding:10px;'>#############################################################################
# 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 = &#039;1.73&#039;;  ## 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;&quot;Warnings&quot;&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 &#039;=xxxx&#039; commands, unknown &#039;XE&lt;lt&gt;...E&lt;gt&gt;&#039; 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&#039;t no
heading!

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

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

=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 * &#039;=item&#039; outside of any &#039;=over&#039;

=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&#039;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: &#039;=over&#039; or &#039;=over positive_number&#039;

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 * &#039;=end&#039; without a target?

&#039;=end&#039; directives need to have a target, just like =begin directives.

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

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

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

I&lt;CONTENT&gt; needs to match =begin&#039;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;&quot;&quot;&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 * 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.

=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&#039;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&#039;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 &#039;=cut&#039; 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&#039;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 &#039;=item I&lt;EXPECTED VALUE&gt;&#039;

=item * Expected &#039;=item *&#039;

=item * Possible =item type mismatch: &#039;I&lt;x&gt;&#039; 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 &#039;=item x&#039; instead of the expected &#039;=item I&lt;N&gt;&#039;

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 `-&#039; 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;.

=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 &#039;%s&#039; 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 &quot;/&quot; 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.
&quot;Pod syntax OK&quot;) 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 Pod::Simple as opposed to all previous versions
inheriting from Pod::Parser. Do B&lt;not&gt; use Pod::Simple&#039;s interface when
using Pod::Checker unless it is documented somewhere on this page. I
repeat, DO B&lt;NOT&gt; USE POD::SIMPLE&#039;S INTERFACE.

=cut

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

#use diagnostics;
use Carp qw(croak);
use Exporter &#039;import&#039;;
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;{&#039;output_fh&#039;} ||= *STDERR{IO};

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

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

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

    $new-&gt;accept_targets(&#039;*&#039;); # 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 &quot;@_&quot;. 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 &#039;WARNING&#039; or &#039;ERROR&#039;.

=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{&#039;-msg&#039;} || &#039;&#039;).&quot;@_&quot; );
    my $line = (exists $opts{&#039;-line&#039;}) ? &quot; at line $opts{&#039;-line&#039;}&quot; : &#039;&#039;;
    my $file = &#039; in file &#039; . ((exists $opts{&#039;-file&#039;})
                              ? $opts{&#039;-file&#039;}
                              : ((defined $self-&gt;source_filename)
                                 ? $self-&gt;source_filename
                                 : &quot;???&quot;));
    unless (exists $opts{&#039;-severity&#039;}) {
       ## See if can find severity in message prefix
       $opts{&#039;-severity&#039;} = $1  if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// );
    }
    my $severity = (exists $opts{&#039;-severity&#039;}) ? &quot;*** $opts{-severity}: &quot; : &#039;&#039;;

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

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

=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;{&#039;_NUM_ERRORS&#039;} = $_[1]) : $_[0]-&gt;{&#039;_NUM_ERRORS&#039;};
}

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

=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;{&#039;_NUM_WARNINGS&#039;} = $_[1]) :
                      $_[0]-&gt;{&#039;_NUM_WARNINGS&#039;};
}

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

=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;{&#039;_pod_name&#039;} = $_[1]) : $_[0]-&gt;{&#039;_pod_name&#039;};
}

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

=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;{&#039;_nodes&#039;}}, $text);
        # keep also a uniqueness counter
        $self-&gt;{&#039;_unique_nodes&#039;}-&gt;{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self-&gt;{&#039;_nodes&#039;}};
}

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

=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;{&#039;_index&#039;}}, $text);
        # keep also a uniqueness counter
        $self-&gt;{&#039;_unique_nodes&#039;}-&gt;{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self-&gt;{&#039;_index&#039;}};
}

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

# 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;{&#039;_links&#039;}}, $_[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;{&#039;_links&#039;}};
}

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

# override Pod::Simple&#039;s whine() and scream() to use poderror()

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


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

    my $severity = &#039;ERROR&#039;;

    if (0) {
      # XXX: Let&#039;s standardize what&#039;s a warning and what&#039;s an error.  Let&#039;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 = &#039;WARNING&#039; if
          $complaint =~ /^Expected &#039;=item .+?&#039;$/ ||
          $complaint =~ /^You can&#039;t have =items \(as at line .+?\) unless the first thing after the =over is an =item$/ ||
          $complaint =~ /^You have &#039;=item .+?&#039; instead of the expected &#039;=item .+?&#039;$/;
    }

    $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; &#039;ERROR&#039;, # consider making severity &#039;FATAL&#039;
                      -msg =&gt; $complaint });

    return 1;
}


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

# Some helper subroutines

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

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;&#039;s
    return if $inner eq &#039;L&#039; &amp;&amp; $Pod::Simple::VERSION ge &#039;3.33&#039;;

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

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

sub handle_text { $_[0]{&#039;_thispara&#039;} .= $_[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; &#039;WARNING&#039;,
        -msg =&gt; &#039;line containing nothing but whitespace in paragraph&#039;});
}

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

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

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

    if ($self-&gt;{&#039;_head_num&#039;} == 1 &amp;&amp; $self-&gt;{&#039;_head_text&#039;} eq &#039;NAME&#039;) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{&#039;_line&#039;},
                          -severity =&gt; &#039;WARNING&#039;,
                          -msg =&gt; &#039;Verbatim paragraph in NAME section&#039; });
    }
}
# Don&#039;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;{&#039;_head_num&#039;};
    $self-&gt;{&#039;_head_num&#039;} = $h;
    $self-&gt;{&quot;_count_head$h&quot;}++;

    if ($h &gt; 1 &amp;&amp; !$self-&gt;{&#039;_count_head&#039;.($h-1)}) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{&#039;_line&#039;},
                          -severity =&gt; &#039;WARNING&#039;,
                          -msg =&gt; &quot;=head$h without preceding higher level&quot;});
    }

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

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;{&#039;_thispara&#039;};
    $arg =~ s/\s+$//;
    $self-&gt;{&#039;_head_text&#039;} = $arg;
    $self-&gt;{&#039;_cmds_since_head&#039;} = 0;
    my $h = $self-&gt;{&#039;_head_num&#039;};
    $self-&gt;node($arg); # remember this node
    if ($arg eq &#039;&#039;) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{&#039;_line&#039;},
                          -severity =&gt; &#039;ERROR&#039;,
                          -msg =&gt; &quot;empty =head$h&quot; });
    }
}

sub start_over_bullet { shift-&gt;start_over(@_, &#039;bullet&#039;) }
sub start_over_number { shift-&gt;start_over(@_, &#039;number&#039;) }
sub start_over_text   { shift-&gt;start_over(@_, &#039;definition&#039;) }
sub start_over_block  { shift-&gt;start_over(@_, &#039;block&#039;) }
sub start_over_empty  {
    my $self = shift;
    $self-&gt;start_over(@_, &#039;empty&#039;);
    $self-&gt;poderror({ -line =&gt; $self-&gt;{&#039;_line&#039;},
                      -severity =&gt; &#039;WARNING&#039;,
                      -msg =&gt; &#039;empty =over/=back block&#039; });
}
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(&#039;bullet&#039;) }
sub end_item_number { shift-&gt;end_item(&#039;number&#039;) }
sub end_item_text   { shift-&gt;end_item(&#039;definition&#039;) }
sub end_item {
    my $self = shift;
    my $type = shift;
    # If there is verbatim text in this item, it will show up as part of
    # &#039;paras&#039;, and not part of &#039;_thispara&#039;.  If the first para after this is a
    # verbatim one, it actually will be (part of) the contents for this item.
    if (   $self-&gt;{&#039;_thispara&#039;} eq &#039;&#039;
        &amp;&amp; (  ! @{$self-&gt;{&#039;paras&#039;}}
            ||    $self-&gt;{&#039;paras&#039;}[0][0] !~ /Verbatim/i))
    {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{&#039;_line&#039;},
                          -severity =&gt; &#039;WARNING&#039;,
                          -msg =&gt; &#039;=item has no contents&#039; });
    }

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

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

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

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 &quot;&quot;?
    # I don&#039;t know what I was thinking when I made the above TODO, and I don&#039;t
    # know what it means...

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

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

########  Formatting codes

sub start_B { shift-&gt;start_fcode(&#039;B&#039;) }
sub start_C { shift-&gt;start_fcode(&#039;C&#039;) }
sub start_F { shift-&gt;start_fcode(&#039;F&#039;) }
sub start_I { shift-&gt;start_fcode(&#039;I&#039;) }
sub start_S { shift-&gt;start_fcode(&#039;S&#039;) }
sub start_fcode {
    my ($self, $fcode) = @_;
    unshift @{$self-&gt;{&#039;_fcode_stack&#039;}}, $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;{&#039;_fcode_stack&#039;}}, # current fcode removed
                        $self-&gt;{&#039;_fcode_stack&#039;}); # previous fcodes
}

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

    my $link = Pod::Checker::Hyperlink-&gt;new($flags, $self);
    if ($link) {
        if (   $link-&gt;type eq &#039;pod&#039;
            &amp;&amp; $link-&gt;node
                # It&#039;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;{&#039;_pod_name&#039;}
                                  &amp;&amp; $link-&gt;page eq $self-&gt;{&#039;_pod_name&#039;})))
        {
            push @{ $self-&gt;{&#039;_internal_links&#039;} }, [ $link-&gt;{&#039;-raw_node&#039;}, $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(&#039;X&#039;);
    # 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;{&#039;_fcode_pos&#039;}}, length $self-&gt;{&#039;_thispara&#039;};
}
sub end_X {
    my $self = shift;
    # extract contents of X&lt;&gt; and replace with &#039;&#039;
    my $start = pop @{$self-&gt;{&#039;_fcode_pos&#039;}}; # start at the beginning of X&lt;&gt;
    my $end = length($self-&gt;{&#039;_thispara&#039;}) - $start; # end at end of X&lt;&gt;
    my $x = substr($self-&gt;{&#039;_thispara&#039;}, $start, $end, &#039;&#039;);
    if ($x eq &quot;&quot;) {
        $self-&gt;poderror({ -line =&gt; $self-&gt;{&#039;_line&#039;},
                          -severity =&gt; &#039;ERROR&#039;,
                          -msg =&gt; &quot;An empty X&lt;&gt;&quot; });
    }
    $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;{&#039;-line&#039;} ||= $caller-&gt;{&#039;_line&#039;};
    $self-&gt;{&#039;-type&#039;} ||= $simple_link-&gt;{&#039;type&#039;};

    # Force stringification of page and node.  (This expands any E&lt;&gt;.)
    $self-&gt;{&#039;-page&#039;} = exists $simple_link-&gt;{&#039;to&#039;} ? &quot;$simple_link-&gt;{&#039;to&#039;}&quot; : &quot;&quot;;
    $self-&gt;{&#039;-node&#039;} = exists $simple_link-&gt;{&#039;section&#039;} ? &quot;$simple_link-&gt;{&#039;section&#039;}&quot; : &quot;&quot;;

    # 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;{&#039;-raw_node&#039;} = $self-&gt;{&#039;-node&#039;};

    # 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;{&#039;-page&#039;} =~ s/ ^ \s+ //x;
    $self-&gt;{&#039;-page&#039;} =~ s/ \s+ $ //x;

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

    # Pod::Simple warns about L&lt;&gt; and L&lt; &gt;, but not L&lt;/&gt;
    if ($self-&gt;{&#039;-page&#039;} eq &quot;&quot; &amp;&amp; $self-&gt;{&#039;-node&#039;} eq &quot;&quot;) {
        $caller-&gt;poderror({ -line =&gt; $caller-&gt;{&#039;_line&#039;},
                          -severity =&gt; &#039;WARNING&#039;,
                          -msg =&gt; &#039;empty link&#039;});
        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;&quot;url&quot;&gt; for things like
C&lt;http://www.foo&gt;, C&lt;&quot;man&quot;&gt; for man pages, or C&lt;&quot;pod&quot;&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;&quot;&quot;&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
</textarea><br><br><input type='hidden' name='archivo_editar' value='/usr/share/perl5/vendor_perl/Pod/Checker.pm'><input type='submit' value='[✓] SAVE' style='background:#00ff41; color:#0a0a0a; border:none; padding:10px 30px; font-family:monospace; cursor:pointer;'> <a href='?path=%2Fusr%2Fshare%2Fperl5%2Fvendor_perl%2FPod' style='color:#858585; text-decoration:none; padding:10px 30px; border:1px solid #858585;'>[✗] CANCEL</a></form></div><div style='color:#00ff41; font-family:monospace; text-align:center; padding:20px;'>[~] Kerym Chaeceran</div>