package Pod::Checker;
use vars qw($VERSION);
-$VERSION = 1.096; ## Current version of this package
+$VERSION = 1.097; ## Current version of this package
require 5.004; ## requires this Perl version or later
use Pod::ParseUtils; ## for hyperlinks and lists
=over 4
+=item * empty =headn
+
+A heading (C<=head1> or C<=head2>) without any text? That ain't no
+heading!
+
=item * =over on line I<N> without closing =back
The C<=over> command does not have a corresponding C<=back> before the
=item * Nested =begin's
-There were at least two concecutive C<=begin> commands without
+There were at least two consecutive C<=begin> commands without
the corresponding C<=end>. Only one C<=begin> may be active at
a time.
=item * garbled entity I<STRING>
-The I<STRING> found cannot be interpreted as an character entity.
+The I<STRING> found cannot be interpreted as a character entity.
+
+=item * Entity number out of range
+
+An entity specified by number (dec, hex, oct) is out of range (1-255).
=item * malformed link LE<lt>E<gt>
The link found cannot be parsed because it does not conform to the
syntax described in L<perlpod>.
+=item * nonempty ZE<lt>E<gt>
+
+The C<ZE<lt>E<gt>> sequence is supposed to be empty.
+
+=item * Spurious text after =pod / =cut
+
+The commands C<=pod> and C<=cut> do not take any arguments.
+
+=item * Spurious character(s) after =back
+
+The C<=back> command does not take any arguments.
+
=back
=head2 Warnings
=over 4
+=item * multiple occurence of link target I<name>
+
+The POD file has some C<=item> and/or C<=head> commands that have
+the same text. Potential hyperlinks to such a text cannot be unique then.
+
+=item * line containing nothing but whitespace in paragraph
+
+There is some whitespace on a seemingly empty line. POD is very sensitive
+to such things, so this is flagged. B<vi> users switch on the B<list>
+option to avoid this problem.
+
+=item * file does not start with =head
+
+The file starts with a different POD directive than head.
+This is most probably something you do not want.
+
=item * No numeric argument for =over
The C<=over> command is supposed to have a numeric argument (the
indentation).
-=item * Spurious character(s) after =back
+=item * previous =item has no contents
-The C<=back> command does not take any arguments.
+There is a list C<=item> right above the flagged line that has no
+text contents. You probably want to delete empty items.
+
+=item * preceding non-item paragraph(s)
+
+A list introduced by C<=over> starts with a text or verbatim paragraph,
+but continues with C<=item>s. Move the non-item paragraph out of the
+C<=over>/C<=back> block.
+
+=item * =item type mismatch (I<one> vs. I<two>)
+
+A list started with e.g. a bulletted 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 * I<N> unescaped C<E<lt>E<gt>> in paragraph
can potentially cause errors as they could be misinterpreted as
markup commands.
-=item * Non-standard entity
+=item * Unknown entity
A character entity was found that does not belong to the standard
-ISO set.
+ISO set or the POD specials C<verbar> and C<sol>.
=item * No items in =over
-The list does not contain any items.
+The list opened with C<=over> does not contain any items.
=item * No argument for =item
by a dot) to indicate an ordered (numbered) list or simple text for a
definition 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
+C<=head1> followed immediately by C<=head2> does not trigger this warning.
+
=item * Verbatim paragraph in NAME section
The NAME section (C<=head1 NAME>) should consist of a single paragraph
iquest => '¿',
'times' => '×', # times is a keyword in perl
divide => '÷',
+
+# some POD special entities
+ verbar => '|',
+ sol => '/'
);
##---------------------------------------------------------------------------
## Now create a pod checker
my $checker = new Pod::Checker(%options);
+ $checker->parseopts(-process_cut_cmd => 1);
## Now check the pod document for errors
$checker->parse_from_file($infile, $outfile);
## Method definitions begin here
##-------------------------------
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my %params = @_;
- my $self = {%params};
- bless $self, $class;
- $self->initialize();
- return $self;
-}
+## sub new {
+## my $this = shift;
+## my $class = ref($this) || $this;
+## my %params = @_;
+## my $self = {%params};
+## bless $self, $class;
+## $self->initialize();
+## return $self;
+## }
sub initialize {
my $self = shift;
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}: " : "";
## Increment error count and print message "
sub node {
my ($self,$text) = @_;
if(defined $text) {
- $text =~ s/[\s\n]+$//; # strip trailing whitespace
- # add node
+ $text =~ s/\s+$//s; # strip trailing whitespace
+ $text =~ s/\s+/ /gs; # collapse whitespace
+ # add node, order important!
push(@{$self->{_nodes}}, $text);
+ # keep also a uniqueness counter
+ $self->{_unique_nodes}->{$text}++;
return $text;
}
@{$self->{_nodes}};
## overrides for Pod::Parser
sub end_pod {
- ## Do some final checks and
- ## print the number of errors found
- my $self = shift;
- my $infile = $self->input_file();
- my $out_fh = $self->output_handle();
-
- if(@{$self->{_list_stack}}) {
- # _TODO_ display, but don't count them for now
- my $list;
- while($list = shift(@{$self->{_list_stack}})) {
- $self->poderror({ -line => 'EOF', -file => $infile,
- -severity => 'ERROR', -msg => "=over on line " .
- $list->start() . " without closing =back" }); #"
- }
- }
-
- # check validity of document internal hyperlinks
- # first build the node names from the paragraph text
- my %nodes;
- foreach($self->node()) {
- $nodes{$_} = 1;
- if(/^(\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
- }
- }
- foreach($self->hyperlink()) {
- my $line = '';
- s/^(\d+):// && ($line = $1);
- if($_ && !$nodes{$_}) {
- $self->poderror({ -line => $line, -file => $infile,
- -severity => 'ERROR',
- -msg => "unresolved internal link `$_'"});
- }
- }
-
- ## Print the number of errors found
- my $num_errors = $self->num_errors();
- if ($num_errors > 0) {
- printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
+ ## Do some final checks and
+ ## print the number of errors found
+ my $self = shift;
+ my $infile = $self->input_file();
+ my $out_fh = $self->output_handle();
+
+ if(@{$self->{_list_stack}}) {
+ # _TODO_ display, but don't count them for now
+ my $list;
+ 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" }); #"
+ }
+ }
+
+ # check validity of document internal hyperlinks
+ # first build the node names from the paragraph text
+ my %nodes;
+ foreach($self->node()) {
+ $nodes{$_} = 1;
+ if(/^(\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
+ }
+ }
+ foreach($self->hyperlink()) {
+ my $line = '';
+ s/^(\d+):// && ($line = $1);
+ if($_ && !$nodes{$_}) {
+ $self->poderror({ -line => $line, -file => $infile,
+ -severity => 'ERROR',
+ -msg => "unresolved internal link '$_'"});
+ }
+ }
+ foreach(grep($self->{_unique_nodes}->{$_} > 1,
+ keys %{$self->{_unique_nodes}})) {
+ $self->poderror({ -line => '-', -file => $infile,
+ -severity => 'WARNING',
+ -msg => "multiple occurence of link target '$_'"});
+ }
+
+ ## Print the number of errors found
+ my $num_errors = $self->num_errors();
+ if ($num_errors > 0) {
+ printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
($num_errors == 1) ? "error" : "errors");
- }
- elsif($self->{_commands} == 0) {
- print $out_fh "$infile does not contain any pod commands.\n";
- $self->num_errors(-1);
- }
- else {
- print $out_fh "$infile pod syntax OK.\n";
- }
+ }
+ elsif($self->{_commands} == 0) {
+ print $out_fh "$infile does not contain any pod commands.\n";
+ $self->num_errors(-1);
+ }
+ else {
+ print $out_fh "$infile pod syntax OK.\n";
+ }
}
# check a POD command directive
my $arg; # this will hold the command argument
if (! $VALID_COMMANDS{$cmd}) {
$self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
- -msg => "Unknown command \"$cmd\"" });
+ -msg => "Unknown command '$cmd'" });
}
else {
- $self->{_commands}++; # found a valid command
+ # found a valid command
+ if(!$self->{_commands}++ && $cmd !~ /^head/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "file does not start with =head" });
+ }
## check syntax of particular command
if($cmd eq 'over') {
# check for argument
-msg => "No numeric argument for =over"});
}
# start a new list
- unshift(@{$self->{_list_stack}}, Pod::List->new(
- -indent => $indent,
- -start => $line,
- -file => $file));
+ $self->_open_list($indent,$line,$file);
}
elsif($cmd eq 'item') {
# are we in a list?
-severity => 'ERROR',
-msg => "=item without previous =over" });
# auto-open in case we encounter many more
- unshift(@{$self->{_list_stack}},
- Pod::List->new(
- -indent => 'auto',
- -start => $line,
- -file => $file));
+ $self->_open_list('auto',$line,$file);
+ }
+ my $list = $self->{_list_stack}->[0];
+ # check whether the previous item had some contents
+ 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" });
+ }
+ if($list->{_has_par}) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "preceding non-item paragraph(s)" });
+ delete $list->{_has_par};
}
# check for argument
$arg = $self->interpolate_and_check($paragraph, $line, $file);
- unless($arg && $arg =~ /(\S+)/) {
+ if($arg && $arg =~ /(\S+)/) {
+ $arg =~ s/[\s\n]+$//;
+ my $type;
+ if($arg =~ /^[*]\s*(\S*.*)/) {
+ $type = 'bullet';
+ $self->{_list_item_contents} = $1 ? 1 : 0;
+ $arg = $1;
+ }
+ elsif($arg =~ /^\d+\.?\s*(\S*)/) {
+ $type = 'number';
+ $self->{_list_item_contents} = $1 ? 1 : 0;
+ $arg = $1;
+ }
+ else {
+ $type = 'definition';
+ $self->{_list_item_contents} = 1;
+ }
+ my $first = $list->type();
+ if($first && $first ne $type) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "=item type mismatch ('$first' vs. '$type')"});
+ }
+ else { # first item
+ $list->type($type);
+ }
+ }
+ else {
$self->poderror({ -line => $line, -file => $file,
-severity => 'WARNING',
-msg => "No argument for =item" });
$arg = ' '; # empty
+ $self->{_list_item_contents} = 0;
}
# add this item
- $self->{_list_stack}[0]->item($arg);
+ $list->item($arg);
# remember this node
$self->node($arg);
}
$arg = $self->interpolate_and_check($paragraph, $line,$file);
if($arg && $arg =~ /\S/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
+ -severity => 'ERROR',
-msg => "Spurious character(s) after =back" });
}
# close list
- my $list = shift @{$self->{_list_stack}};
+ my $list = $self->_close_list($line,$file);
# check for empty lists
if(!$list->item() && $self->{-warnings}) {
$self->poderror({ -line => $line, -file => $file,
}
}
}
- elsif($cmd =~ /^head/) {
+ elsif($cmd =~ /^head(\d+)/) {
+ if(defined $self->{_commands_in_head} &&
+ $self->{_commands_in_head} == 0 &&
+ defined $self->{_last_head} &&
+ $self->{_last_head} >= $1) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'WARNING',
+ -msg => "empty section in previous paragraph"});
+ }
+ $self->{_commands_in_head} = -1;
+ $self->{_last_head} = $1;
# check if there is an open list
if(@{$self->{_list_stack}}) {
my $list;
- while($list = shift(@{$self->{_list_stack}})) {
+ 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() .
}
# remember this node
$arg = $self->interpolate_and_check($paragraph, $line,$file);
- $self->node($arg) if($arg);
+ $arg =~ s/[\s\n]+$//s;
+ $self->node($arg);
+ unless(length($arg)) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "empty =$cmd"});
+ }
if($cmd eq 'head1') {
- $arg =~ s/[\s\n]+$//;
$self->{_current_head1} = $arg;
} else {
$self->{_current_head1} = '';
}
$arg = ''; # do not expand paragraph below
}
+ elsif($cmd =~ /^(pod|cut)$/) {
+ # check for argument
+ $arg = $self->interpolate_and_check($paragraph, $line,$file);
+ if($arg && $arg =~ /(\S+)/) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "Spurious text after =$cmd"});
+ }
+ }
+ $self->{_commands_in_head}++;
## Check the interior sequences in the command-text
$self->interpolate_and_check($paragraph, $line,$file)
unless(defined $arg);
}
}
+sub _open_list
+{
+ my ($self,$indent,$line,$file) = @_;
+ my $list = Pod::List->new(
+ -indent => $indent,
+ -start => $line,
+ -file => $file);
+ unshift(@{$self->{_list_stack}}, $list);
+ undef $self->{_list_item_contents};
+ $list;
+}
+
+sub _close_list
+{
+ my ($self,$line,$file) = @_;
+ my $list = shift(@{$self->{_list_stack}});
+ 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" });
+ }
+ undef $self->{_list_item_contents};
+ $list;
+}
+
# process a block of some text
sub interpolate_and_check {
my ($self, $paragraph, $line, $file) = @_;
if (! $VALID_SEQUENCES{$cmd}) {
$self->poderror({ -line => $line, -file => $file,
-severity => 'ERROR',
- -msg => qq(Unknown interior-sequence "$cmd")});
+ -msg => qq(Unknown interior-sequence '$cmd')});
# expand it anyway
$text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
next;
next;
}
my $ent = $$contents[0];
- if($ent =~ /^\d+$/) {
+ my $val;
+ if($ent =~ /^0x[0-9a-f]+$/i) {
+ # hexadec entity
+ $val = hex($ent);
+ }
+ elsif($ent =~ /^0\d+$/) {
+ # octal
+ $val = oct($ent);
+ }
+ elsif($ent =~ /^\d+$/) {
# numeric entity
- $text .= chr($ent);
+ $val = $ent;
+ }
+ if(defined $val) {
+ if($val>0 && $val<256) {
+ $text .= chr($val);
+ }
+ else {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "Entity number out of range " . $_->raw_text()});
+ }
}
elsif($ENTITIES{$ent}) {
# known ISO entity
else {
$self->poderror({ -line => $line, -file => $file,
-severity => 'WARNING',
- -msg => "Non-standard entity " . $_->raw_text()});
+ -msg => "Unknown entity " . $_->raw_text()});
$text .= "E<$ent>";
}
}
# add the guts
$text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
}
- else {
- # check, but add nothing to $text (X<>, Z<>)
+ elsif($cmd eq 'Z') {
+ if(length($contents->raw_text())) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "Nonempty Z<>"});
+ }
+ }
+ else { # X<>
+ # check, but add nothing to $text
$self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
}
}
# process a block of verbatim text
sub verbatim {
- ## Nothing to check
+ ## Nothing particular to check
my ($self, $paragraph, $line_num, $pod_para) = @_;
+
+ $self->_preproc_par($paragraph);
+
if($self->{_current_head1} eq 'NAME') {
my ($file, $line) = $pod_para->file_line;
$self->poderror({ -line => $line, -file => $file,
my ($self, $paragraph, $line_num, $pod_para) = @_;
my ($file, $line) = $pod_para->file_line;
+ $self->_preproc_par($paragraph);
+
# skip this paragraph if in a =begin block
unless($self->{_have_begin}) {
my $block = $self->interpolate_and_check($paragraph, $line,$file);
}
}
+sub _preproc_par
+{
+ my $self = shift;
+ $_[0] =~ s/[\s\n]+$//;
+ if($_[0]) {
+ $self->{_commands_in_head}++;
+ $self->{_list_item_contents}++ if(defined $self->{_list_item_contents});
+ if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) {
+ $self->{_list_stack}->[0]->{_has_par} = 1;
+ }
+ }
+}
+
1;
+
projects / p5sagit/p5-mst-13.2.git / blobdiff