#############################################################################
package Pod::Checker;
+use strict;
-use vars qw($VERSION);
-$VERSION = 1.43; ## Current version of this package
+use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES);
+$VERSION = '1.45'; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Pod::ParseUtils; ## for hyperlinks and lists
=item *
-Check for same nested interior-sequences (e.g.
+Check for same nested interior-sequences (e.g.
C<LE<lt>...LE<lt>...E<gt>...E<gt>>).
=item *
-Check for malformed or nonexisting entities C<EE<lt>...E<gt>>.
+Check for malformed or non-existing entities C<EE<lt>...E<gt>>.
=item *
=item * unresolved internal link I<NAME>
The given link to I<NAME> does not have a matching node in the current
-POD. This also happend when a single word node name is not enclosed in
+POD. This also happened when a single word node name is not enclosed in
C<"">.
=item * Unknown command "I<CMD>"
=item * Unknown interior-sequence "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<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 * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt>
=item * =item type mismatch (I<one> vs. I<two>)
-A list started with e.g. a bulletted C<=item> and continued with a
+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 * 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
+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
=head2 Hyperlinks
-There are some warnings wrt. malformed 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
+There is whitespace at the beginning or the end of the contents of
LE<lt>...E<gt>.
=item * (section) in '$page' deprecated
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.
+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 behavio
ur. Users of B<podchecker> (the script)
-get the well-known behaviour.
+control completely the output behavior. Users of B<podchecker> (the script)
+get the well-known behavior.
=cut
#############################################################################
-use strict;
#use diagnostics;
-use Carp;
+use Carp qw(croak);
use Exporter;
use Pod::Parser;
-use vars qw(@ISA @EXPORT);
@ISA = qw(Pod::Parser);
@EXPORT = qw(&podchecker);
-use vars qw(%VALID_COMMANDS %VALID_SEQUENCES);
-
my %VALID_COMMANDS = (
'pod' => 1,
'cut' => 1,
'for' => 1,
'begin' => 1,
'end' => 1,
+ 'encoding' => 1,
);
my %VALID_SEQUENCES = (
# stolen from HTML::Entities
my %ENTITIES = (
# Some normal chars that have special meaning in SGML context
- amp => '&', # ampersand
+ amp => '&', # ampersand
'gt' => '>', # greater than
'lt' => '<', # less than
quot => '"', # double quote
# PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
- AElig => 'Æ', # capital AE diphthong (ligature)
- Aacute => 'Á', # capital A, acute accent
- Acirc => 'Â', # capital A, circumflex accent
- Agrave => 'À', # capital A, grave accent
- Aring => 'Å', # capital A, ring
- Atilde => 'Ã', # capital A, tilde
- Auml => 'Ä', # capital A, dieresis or umlaut mark
- Ccedil => 'Ç', # capital C, cedilla
- ETH => 'Ð', # capital Eth, Icelandic
- Eacute => 'É', # capital E, acute accent
- Ecirc => 'Ê', # capital E, circumflex accent
- Egrave => 'È', # capital E, grave accent
- Euml => 'Ë', # capital E, dieresis or umlaut mark
- Iacute => 'Í', # capital I, acute accent
- Icirc => 'Î', # capital I, circumflex accent
- Igrave => 'Ì', # capital I, grave accent
- Iuml => 'Ï', # capital I, dieresis or umlaut mark
- Ntilde => 'Ñ', # capital N, tilde
- Oacute => 'Ó', # capital O, acute accent
- Ocirc => 'Ô', # capital O, circumflex accent
- Ograve => 'Ò', # capital O, grave accent
- Oslash => 'Ø', # capital O, slash
- Otilde => 'Õ', # capital O, tilde
- Ouml => 'Ö', # capital O, dieresis or umlaut mark
- THORN => 'Þ', # capital THORN, Icelandic
- Uacute => 'Ú', # capital U, acute accent
- Ucirc => 'Û', # capital U, circumflex accent
- Ugrave => 'Ù', # capital U, grave accent
- Uuml => 'Ü', # capital U, dieresis or umlaut mark
- Yacute => 'Ý', # capital Y, acute accent
- aacute => 'á', # small a, acute accent
- acirc => 'â', # small a, circumflex accent
- aelig => 'æ', # small ae diphthong (ligature)
- agrave => 'à', # small a, grave accent
- aring => 'å', # small a, ring
- atilde => 'ã', # small a, tilde
- auml => 'ä', # small a, dieresis or umlaut mark
- ccedil => 'ç', # small c, cedilla
- eacute => 'é', # small e, acute accent
- ecirc => 'ê', # small e, circumflex accent
- egrave => 'è', # small e, grave accent
- eth => 'ð', # small eth, Icelandic
- euml => 'ë', # small e, dieresis or umlaut mark
- iacute => 'í', # small i, acute accent
- icirc => 'î', # small i, circumflex accent
- igrave => 'ì', # small i, grave accent
- iuml => 'ï', # small i, dieresis or umlaut mark
- ntilde => 'ñ', # small n, tilde
- oacute => 'ó', # small o, acute accent
- ocirc => 'ô', # small o, circumflex accent
- ograve => 'ò', # small o, grave accent
- oslash => 'ø', # small o, slash
- otilde => 'õ', # small o, tilde
- ouml => 'ö', # small o, dieresis or umlaut mark
- szlig => 'ß', # small sharp s, German (sz ligature)
- thorn => 'þ', # small thorn, Icelandic
- uacute => 'ú', # small u, acute accent
- ucirc => 'û', # small u, circumflex accent
- ugrave => 'ù', # small u, grave accent
- uuml => 'ü', # small u, dieresis or umlaut mark
- yacute => 'ý', # small y, acute accent
- yuml => 'ÿ', # small y, dieresis or umlaut mark
+ AElig => 'Æ', # capital AE diphthong (ligature)
+ Aacute => 'Á', # capital A, acute accent
+ Acirc => 'Â', # capital A, circumflex accent
+ Agrave => 'À', # capital A, grave accent
+ Aring => 'Å', # capital A, ring
+ Atilde => 'Ã', # capital A, tilde
+ Auml => 'Ä', # capital A, dieresis or umlaut mark
+ Ccedil => 'Ç', # capital C, cedilla
+ ETH => 'Ð', # capital Eth, Icelandic
+ Eacute => 'É', # capital E, acute accent
+ Ecirc => 'Ê', # capital E, circumflex accent
+ Egrave => 'È', # capital E, grave accent
+ Euml => 'Ë', # capital E, dieresis or umlaut mark
+ Iacute => 'Í', # capital I, acute accent
+ Icirc => 'Î', # capital I, circumflex accent
+ Igrave => 'Ì', # capital I, grave accent
+ Iuml => 'Ï', # capital I, dieresis or umlaut mark
+ Ntilde => 'Ñ', # capital N, tilde
+ Oacute => 'Ó', # capital O, acute accent
+ Ocirc => 'Ô', # capital O, circumflex accent
+ Ograve => 'Ò', # capital O, grave accent
+ Oslash => 'Ø', # capital O, slash
+ Otilde => 'Õ', # capital O, tilde
+ Ouml => 'Ö', # capital O, dieresis or umlaut mark
+ THORN => 'Þ', # capital THORN, Icelandic
+ Uacute => 'Ú', # capital U, acute accent
+ Ucirc => 'Û', # capital U, circumflex accent
+ Ugrave => 'Ù', # capital U, grave accent
+ Uuml => 'Ü', # capital U, dieresis or umlaut mark
+ Yacute => 'Ý', # capital Y, acute accent
+ aacute => 'á', # small a, acute accent
+ acirc => 'â', # small a, circumflex accent
+ aelig => 'æ', # small ae diphthong (ligature)
+ agrave => 'à', # small a, grave accent
+ aring => 'å', # small a, ring
+ atilde => 'ã', # small a, tilde
+ auml => 'ä', # small a, dieresis or umlaut mark
+ ccedil => 'ç', # small c, cedilla
+ eacute => 'é', # small e, acute accent
+ ecirc => 'ê', # small e, circumflex accent
+ egrave => 'è', # small e, grave accent
+ eth => 'ð', # small eth, Icelandic
+ euml => 'ë', # small e, dieresis or umlaut mark
+ iacute => 'í', # small i, acute accent
+ icirc => 'î', # small i, circumflex accent
+ igrave => 'ì', # small i, grave accent
+ iuml => 'ï', # small i, dieresis or umlaut mark
+ ntilde => 'ñ', # small n, tilde
+ oacute => 'ó', # small o, acute accent
+ ocirc => 'ô', # small o, circumflex accent
+ ograve => 'ò', # small o, grave accent
+ oslash => 'ø', # small o, slash
+ otilde => 'õ', # small o, tilde
+ ouml => 'ö', # small o, dieresis or umlaut mark
+ szlig => 'ß', # small sharp s, German (sz ligature)
+ thorn => 'þ', # small thorn, Icelandic
+ uacute => 'ú', # small u, acute accent
+ ucirc => 'û', # small u, circumflex accent
+ ugrave => 'ù', # small u, grave accent
+ uuml => 'ü', # small u, dieresis or umlaut mark
+ yacute => 'ý', # small y, acute accent
+ yuml => 'ÿ', # small y, dieresis or umlaut mark
# Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
copy => '©', # copyright sign
## Function definitions begin here
##---------------------------------
-sub podchecker( $ ; $ % ) {
+sub podchecker {
my ($infile, $outfile, %options) = @_;
local $_;
my %opts = (ref $_[0]) ? %{shift()} : ();
## Retrieve options
- chomp( my $msg = ($opts{-msg} || "")."@_" );
- my $line = (exists $opts{-line}) ? " at line $opts{-line}" : "";
- my $file = (exists $opts{-file}) ? " in file $opts{-file}" : "";
+ chomp( my $msg = ($opts{-msg} || '')."@_" );
+ my $line = (exists $opts{-line}) ? " at line $opts{-line}" : '';
+ my $file = (exists $opts{-file}) ? " in file $opts{-file}" : '';
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}: " : "";
+ my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : '';
## Increment error count and print message "
- ++($self->{_NUM_ERRORS})
+ ++($self->{_NUM_ERRORS})
if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
++($self->{_NUM_WARNINGS})
if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
sub name {
return (@_ > 1 && $_[1]) ?
- ($_[0]->{-name} = $_[1]) : $_[0]->{-name};
+ ($_[0]->{-name} = $_[1]) : $_[0]->{-name};
}
##################################
while(($list = $self->_close_list('EOF',$infile)) &&
$list->indent() ne 'auto') {
$self->poderror({ -line => 'EOF', -file => $infile,
- -severity => 'ERROR', -msg => "=over on line " .
- $list->start() . " without closing =back" }); #"
+ -severity => 'ERROR', -msg => '=over on line ' .
+ $list->start() . ' without closing =back' });
}
}
}
# check a POD command directive
-sub command {
+sub command {
my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
my ($file, $line) = $pod_para->file_line;
## Check the command syntax
##### following check disabled due to strong request
#if(!$self->{_commands}++ && $cmd !~ /^head/) {
# $self->poderror({ -line => $line, -file => $file,
- # -severity => 'WARNING',
+ # -severity => 'WARNING',
# -msg => "file does not start with =head" });
#}
# are we in a list?
unless(@{$self->{_list_stack}}) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "=item without previous =over" });
+ -severity => 'ERROR',
+ -msg => '=item without previous =over' });
# auto-open in case we encounter many more
$self->_open_list('auto',$line,$file);
}
if(defined $self->{_list_item_contents} &&
$self->{_list_item_contents} == 0) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "previous =item has no contents" });
+ -severity => 'WARNING',
+ -msg => 'previous =item has no contents' });
}
if($list->{_has_par}) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "preceding non-item paragraph(s)" });
+ -severity => 'WARNING',
+ -msg => 'preceding non-item paragraph(s)' });
delete $list->{_has_par};
}
# check for argument
$self->{_list_item_contents} = $1 ? 1 : 0;
$arg = $1;
}
- elsif($arg =~ /^\d+\.?\s*(\S*)/) {
+ elsif($arg =~ /^\d+\.?\s+(\S*)/) {
$type = 'number';
$self->{_list_item_contents} = $1 ? 1 : 0;
$arg = $1;
my $first = $list->type();
if($first && $first ne $type) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
+ -severity => 'WARNING',
-msg => "=item type mismatch ('$first' vs. '$type')"});
}
else { # first item
}
else {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "No argument for =item" });
- $arg = ' '; # empty
+ -severity => 'WARNING',
+ -msg => 'No argument for =item' });
+ $arg = ' '; # empty
$self->{_list_item_contents} = 0;
}
# add this item
# check if we have an open list
unless(@{$self->{_list_stack}}) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "=back without previous =over" });
+ -severity => 'ERROR',
+ -msg => '=back without previous =over' });
}
else {
# check for spurious characters
$arg = $self->interpolate_and_check($paragraph, $line,$file);
if($arg && $arg =~ /\S/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "Spurious character(s) after =back" });
+ -severity => 'ERROR',
+ -msg => 'Spurious character(s) after =back' });
}
# close list
my $list = $self->_close_list($line,$file);
# check for empty lists
if(!$list->item() && $self->{-warnings}) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "No items in =over (at line " .
- $list->start() . ") / =back list"}); #"
+ -severity => 'WARNING',
+ -msg => 'No items in =over (at line ' .
+ $list->start() . ') / =back list'});
}
}
}
elsif($cmd =~ /^head(\d+)/) {
my $hnum = $1;
$self->{"_have_head_$hnum"}++; # count head types
- if($hnum > 1 && !$self->{"_have_head_".($hnum -1)}) {
+ if($hnum > 1 && !$self->{'_have_head_'.($hnum -1)}) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
+ -severity => 'WARNING',
-msg => "=head$hnum without preceding higher level"});
}
# check whether the previous =head section had some contents
defined $self->{_last_head} &&
$self->{_last_head} >= $hnum) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "empty section in previous paragraph"});
+ -severity => 'WARNING',
+ -msg => 'empty section in previous paragraph'});
}
$self->{_commands_in_head} = -1;
$self->{_last_head} = $hnum;
while(($list = $self->_close_list($line,$file)) &&
$list->indent() ne 'auto') {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "=over on line ". $list->start() .
+ -severity => 'ERROR',
+ -msg => '=over on line '. $list->start() .
" without closing =back (at $cmd)" });
}
}
$self->node($arg);
unless(length($arg)) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
+ -severity => 'ERROR',
-msg => "empty =$cmd"});
}
if($cmd eq 'head1') {
if($self->{_have_begin}) {
# already have a begin
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "Nested =begin's (first at line " .
- $self->{_have_begin} . ")"});
+ -severity => 'ERROR',
+ -msg => q{Nested =begin's (first at line } .
+ $self->{_have_begin} . ')'});
}
else {
# check for argument
$arg = $self->interpolate_and_check($paragraph, $line,$file);
unless($arg && $arg =~ /(\S+)/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "No argument for =begin"});
+ -severity => 'ERROR',
+ -msg => 'No argument for =begin'});
}
# remember the =begin
$self->{_have_begin} = "$line:$1";
# the closing argument is optional
#if($arg && $arg =~ /\S/) {
# $self->poderror({ -line => $line, -file => $file,
- # -severity => 'WARNING',
+ # -severity => 'WARNING',
# -msg => "Spurious character(s) after =end" });
#}
}
else {
# don't have a matching =begin
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "=end without =begin" });
+ -severity => 'ERROR',
+ -msg => '=end without =begin' });
}
}
elsif($cmd eq 'for') {
unless($paragraph =~ /\s*(\S+)\s*/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "=for without formatter specification" });
+ -severity => 'ERROR',
+ -msg => '=for without formatter specification' });
}
$arg = ''; # do not expand paragraph below
}
$arg = $self->interpolate_and_check($paragraph, $line,$file);
if($arg && $arg =~ /(\S+)/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
+ -severity => 'ERROR',
-msg => "Spurious text after =$cmd"});
}
}
if(defined $self->{_list_item_contents} &&
$self->{_list_item_contents} == 0) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "previous =item has no contents" });
+ -severity => 'WARNING',
+ -msg => 'previous =item has no contents' });
}
undef $self->{_list_item_contents};
$list;
my $count;
if($count = tr/<>/<>/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
+ -severity => 'WARNING',
-msg => "$count unescaped <> in paragraph" });
}
}
# check for valid tag
if (! $VALID_SEQUENCES{$cmd}) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
+ -severity => 'ERROR',
-msg => qq(Unknown interior-sequence '$cmd')});
# expand it anyway
$text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
}
if($nestlist =~ /$cmd/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
+ -severity => 'WARNING',
-msg => "nested commands $cmd<...$cmd<...>...>"});
# _TODO_ should we add the contents anyway?
# expand it anyway, see below
# preserve entities
if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "garbled entity " . $_->raw_text()});
+ -severity => 'ERROR',
+ -msg => 'garbled entity ' . $_->raw_text()});
next;
}
my $ent = $$contents[0];
}
else {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "Entity number out of range " . $_->raw_text()});
+ -severity => 'ERROR',
+ -msg => 'Entity number out of range ' . $_->raw_text()});
}
}
elsif($ENTITIES{$ent}) {
}
else {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "Unknown entity " . $_->raw_text()});
+ -severity => 'WARNING',
+ -msg => 'Unknown entity ' . $_->raw_text()});
$text .= "E<$ent>";
}
}
my $link = Pod::Hyperlink->new($contents->raw_text());
unless(defined $link) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "malformed link " . $_->raw_text() ." : $@"});
+ -severity => 'ERROR',
+ -msg => 'malformed link ' . $_->raw_text() ." : $@"});
next;
}
$link->line($line); # remember line
if($self->{-warnings}) {
foreach my $w ($link->warning()) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
+ -severity => 'WARNING',
-msg => $w });
}
}
elsif($cmd eq 'Z') {
if(length($contents->raw_text())) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "Nonempty Z<>"});
+ -severity => 'ERROR',
+ -msg => 'Nonempty Z<>'});
}
}
elsif($cmd eq 'X') {
my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
if($idx =~ /^\s*$/s) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "Empty X<>"});
+ -severity => 'ERROR',
+ -msg => 'Empty X<>'});
}
else {
# remember this node
}
else {
# not reached
- die "internal error";
+ croak 'internal error';
}
}
$text;
}
# process a block of verbatim text
-sub verbatim {
+sub verbatim {
## Nothing particular to check
my ($self, $paragraph, $line_num, $pod_para) = @_;
}
# process a block of regular text
-sub textblock {
+sub textblock {
my ($self, $paragraph, $line_num, $pod_para) = @_;
my ($file, $line) = $pod_para->file_line;
https://perl5.git.perl.org / perl5.git / blobdiff