diff options
Diffstat (limited to 'lib/Pod/Checker.pm')
| -rw-r--r-- | lib/Pod/Checker.pm | 285 |
1 files changed, 141 insertions, 144 deletions
diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm index 5c301b6de6..deac5ded2b 100644 --- a/lib/Pod/Checker.pm +++ b/lib/Pod/Checker.pm @@ -8,9 +8,10 @@ ############################################################################# package Pod::Checker; +use strict; -use vars qw($VERSION); -$VERSION = "1.43_01"; ## Current version of this package +use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES); +$VERSION = '1.44_01'; ## Current version of this package require 5.005; ## requires this Perl version or later use Pod::ParseUtils; ## for hyperlinks and lists @@ -77,7 +78,7 @@ Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. =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 * @@ -154,8 +155,8 @@ C<=for>, C<=pod>, C<=cut> =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> @@ -264,7 +265,7 @@ 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 +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 @@ -288,7 +289,7 @@ There are some warnings with respect to malformed hyperlinks: =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 @@ -329,7 +330,7 @@ a first pass before actually starting to convert. This is expensive in terms of execution time, but allows for very robust conversions. Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror> -method to print errors and warnings. The summary output (e.g. +method to print errors and warnings. The summary output (e.g. "Pod syntax OK") has been dropped from the module and has been included in B<podchecker> (the script). This allows users of B<Pod::Checker> to control completely the output behavior. Users of B<podchecker> (the script) @@ -339,18 +340,14 @@ get the well-known behavior. ############################################################################# -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, @@ -364,7 +361,7 @@ my %VALID_COMMANDS = ( 'for' => 1, 'begin' => 1, 'end' => 1, - 'encoding' => '1', + 'encoding' => 1, ); my %VALID_SEQUENCES = ( @@ -382,74 +379,74 @@ 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 @@ -500,7 +497,7 @@ my %ENTITIES = ( ## Function definitions begin here ##--------------------------------- -sub podchecker( $ ; $ % ) { +sub podchecker { my ($infile, $outfile, %options) = @_; local $_; @@ -610,17 +607,17 @@ sub poderror { 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')); @@ -666,7 +663,7 @@ found in the C<=head1 NAME> section. sub name { return (@_ > 1 && $_[1]) ? - ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; + ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; } ################################## @@ -754,8 +751,8 @@ sub end_pod { 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' }); } } @@ -804,7 +801,7 @@ sub end_pod { } # 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 @@ -819,7 +816,7 @@ sub command { ##### 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" }); #} @@ -838,8 +835,8 @@ sub command { # 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); } @@ -848,13 +845,13 @@ sub command { 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 @@ -879,7 +876,7 @@ sub command { 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 @@ -888,9 +885,9 @@ sub command { } 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 @@ -902,34 +899,34 @@ sub command { # 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 @@ -938,8 +935,8 @@ sub command { 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; @@ -949,8 +946,8 @@ sub command { 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)" }); } } @@ -960,7 +957,7 @@ sub command { $self->node($arg); unless(length($arg)) { $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', + -severity => 'ERROR', -msg => "empty =$cmd"}); } if($cmd eq 'head1') { @@ -973,17 +970,17 @@ sub command { 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"; @@ -998,22 +995,22 @@ sub command { # 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 } @@ -1022,7 +1019,7 @@ sub command { $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"}); } } @@ -1052,8 +1049,8 @@ sub _close_list 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; @@ -1082,7 +1079,7 @@ sub _check_ptree { my $count; if($count = tr/<>/<>/) { $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', + -severity => 'WARNING', -msg => "$count unescaped <> in paragraph" }); } } @@ -1096,7 +1093,7 @@ sub _check_ptree { # 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"); @@ -1104,7 +1101,7 @@ sub _check_ptree { } 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 @@ -1113,8 +1110,8 @@ sub _check_ptree { # 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]; @@ -1137,8 +1134,8 @@ sub _check_ptree { } 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}) { @@ -1147,8 +1144,8 @@ sub _check_ptree { } else { $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "Unknown entity " . $_->raw_text()}); + -severity => 'WARNING', + -msg => 'Unknown entity ' . $_->raw_text()}); $text .= "E<$ent>"; } } @@ -1157,15 +1154,15 @@ sub _check_ptree { 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 }); } } @@ -1182,16 +1179,16 @@ sub _check_ptree { 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 @@ -1200,14 +1197,14 @@ sub _check_ptree { } 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) = @_; @@ -1222,7 +1219,7 @@ sub verbatim { } # process a block of regular text -sub textblock { +sub textblock { my ($self, $paragraph, $line_num, $pod_para) = @_; my ($file, $line) = $pod_para->file_line; |