From 48f30392d43cee251b79c036ba2aa18edf85fc30 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Sat, 26 Feb 2000 15:04:54 +0000 Subject: [PATCH] PodParser v1.11 update (from Brad Appleton) p4raw-id: //depot/perl@5273 --- lib/Pod/Checker.pm | 198 ++++++++++++++++++++++++++++++++++++++---------- lib/Pod/InputObjects.pm | 2 +- lib/Pod/ParseUtils.pm | 53 +++++++++---- lib/Pod/Parser.pm | 4 +- lib/Pod/Select.pm | 2 +- lib/Pod/Usage.pm | 2 +- t/pod/poderrs.t | 4 + t/pod/poderrs.xr | 62 +++++++-------- 8 files changed, 235 insertions(+), 92 deletions(-) diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm index b5f980b..281bd11 100644 --- a/lib/Pod/Checker.pm +++ b/lib/Pod/Checker.pm @@ -10,7 +10,7 @@ package Pod::Checker; use vars qw($VERSION); -$VERSION = 1.097; ## Current version of this package +$VERSION = 1.098; ## Current version of this package require 5.004; ## requires this Perl version or later use Pod::ParseUtils; ## for hyperlinks and lists @@ -26,6 +26,7 @@ Pod::Checker, podchecker() - check pod documents for syntax errors $syntax_okay = podchecker($filepath, $outputpath, %options); my $checker = new Pod::Checker %options; + $checker->parse_from_file($filepath, \*STDERR); =head1 OPTIONS/ARGUMENTS @@ -57,13 +58,13 @@ It is hoped that curious/ambitious user will help flesh out and add the additional features they wish to see in B and B and verify that the checks are consistent with L. -The following checks are preformed: +The following checks are currently preformed: =over 4 =item * -Unknown '=xxxx' commands, unknown 'X<...>' interior-sequences, +Unknown '=xxxx' commands, unknown 'XE...E' interior-sequences, and unterminated interior sequences. =item * @@ -97,14 +98,6 @@ to something else. =back -=head2 Additional Features - -While checking, this module collects document properties, e.g. the nodes -for hyperlinks (C<=headX>, C<=item>). 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. - =head1 DIAGNOSTICS =head2 Errors @@ -188,6 +181,10 @@ syntax described in L. The CE> sequence is supposed to be empty. +=item * empty XEE + +The index entry specified contains nothing but whitespace. + =item * Spurious text after =pod / =cut The commands C<=pod> and C<=cut> do not take any arguments. @@ -293,13 +290,13 @@ there were no POD commands at all found in the file. I<[T.B.D.]> -=head1 AUTHOR +=head1 INTERFACE -Brad Appleton Ebradapp@enteract.comE (initial version), -Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE - -Based on code for B written by -Tom Christiansen Etchrist@mox.perl.comE +While checking, this module collects document properties, e.g. the nodes +for hyperlinks (C<=headX>, C<=item>) and index entries (CE>). +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. =cut @@ -477,7 +474,7 @@ sub podchecker( $ ; $ % ) { ## Now check the pod document for errors $checker->parse_from_file($infile, $outfile); - + ## Return the number of errors found return $checker->num_errors(); } @@ -509,11 +506,42 @@ sub initialize { $self->{_have_begin} = ''; # stores =begin $self->{_links} = []; # stack for internal hyperlinks $self->{_nodes} = []; # stack for =head/=item nodes + $self->{_index} = []; # text in X<> # print warnings? $self->{-warnings} = 1 unless(defined $self->{-warnings}); $self->{_current_head1} = ''; # the current =head1 block } +################################## + +=over 4 + +=item C<$checker-Epoderror( @args )> + +=item C<$checker-Epoderror( {%opts}, @args )> + +Internal method for printing errors and warnings. If no options are +given, simply prints "@_". The following options are recognized and used +to form the output: + + -msg + +A message to print prior to C<@args>. + + -line + +The line number the error occurred in. + + -file + +The file (name) the error occurred in. + + -severity + +The error level, should be 'WARNING' or 'ERROR'. + +=cut + # Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) sub poderror { my $self = shift; @@ -537,18 +565,43 @@ sub poderror { if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); } -# set/retrieve the number of errors found +################################## + +=item C<$checker-Enum_errors()> + +Set (if argument specified) and retrieve the number of errors found. + +=cut + sub num_errors { return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; } -# set and/or retrieve canonical name of POD +################################## + +=item C<$checker-Ename()> + +Set (if argument specified) and retrieve the canonical name of POD as +found in the C<=head1 NAME> section. + +=cut + sub name { return (@_ > 1 && $_[1]) ? ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; } -# set/return nodes of the current POD +################################## + +=item C<$checker-Enode()> + +Add (if argument specified) and retrieve the nodes (as defined by C<=headX> +and C<=item>) of the current POD. The nodes are returned in the order of +their occurence. They consist of plain text, each piece of whitespace is +collapsed to a single blank. + +=cut + sub node { my ($self,$text) = @_; if(defined $text) { @@ -557,12 +610,49 @@ sub node { # add node, order important! push(@{$self->{_nodes}}, $text); # keep also a uniqueness counter - $self->{_unique_nodes}->{$text}++; + $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); return $text; } @{$self->{_nodes}}; } +################################## + +=item C<$checker-Eidx()> + +Add (if argument specified) and retrieve the index entries (as defined by +CE>) 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->{_index}}, $text); + # keep also a uniqueness counter + $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); + return $text; + } + @{$self->{_index}}; +} + +################################## + +=item C<$checker-Ehyperlink()> + +Add (if argument specified) and retrieve the hyperlinks (as defined by +CE>) of the current POD. They consist of an 2-item array: line +number and C object. + +=back + +=cut + # set/return hyperlinks of the current POD sub hyperlink { my $self = shift; @@ -605,14 +695,22 @@ sub end_pod { } } foreach($self->hyperlink()) { - my $line = ''; - s/^(\d+):// && ($line = $1); - if($_ && !$nodes{$_}) { - $self->poderror({ -line => $line, -file => $infile, - -severity => 'ERROR', - -msg => "unresolved internal link '$_'"}); + my ($line,$link) = @$_; + # _TODO_ what if there is a link to the page itself by the name, + # e.g. in Tk::Pod : L + if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { + my $node = $self->_check_ptree($self->parse_text($link->node(), + $line), $line, $infile, 'L'); + if($node && !$nodes{$node}) { + $self->poderror({ -line => $line || '', -file => $infile, + -severity => 'ERROR', + -msg => "unresolved internal link '$node'"}); + } } } + + # check the internal nodes for uniqueness. This pertains to + # =headX, =item and X<...> foreach(grep($self->{_unique_nodes}->{$_} > 1, keys %{$self->{_unique_nodes}})) { $self->poderror({ -line => '-', -file => $infile, @@ -758,6 +856,7 @@ sub command { } } elsif($cmd =~ /^head(\d+)/) { + # check whether the previous =head section had some contents if(defined $self->{_commands_in_head} && $self->{_commands_in_head} == 0 && defined $self->{_last_head} && @@ -996,15 +1095,8 @@ sub _check_ptree { # check the link text $text .= $self->_check_ptree($self->parse_text($link->text(), $line), $line, $file, "$nestlist$cmd"); - my $node = ''; - # remember internal link - # _TODO_ what if there is a link to the page itself by the name, - # e.g. in Tk::Pod : L - if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { - $node = $self->_check_ptree($self->parse_text($link->node(), - $line), $line, $file, "$nestlist$cmd"); - $self->hyperlink("$line:$node") if($node); - } + # remember link + $self->hyperlink([$line,$link]); } elsif($cmd =~ /[BCFIS]/) { # add the guts @@ -1017,16 +1109,26 @@ sub _check_ptree { -msg => "Nonempty Z<>"}); } } - else { # X<> - # check, but add nothing to $text - $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + 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<>"}); + } + else { + # remember this node + $self->idx($idx); + } + } + else { + # not reached + die "internal error"; } } $text; } -# _TODO_ overloadable methods for BC..Z<...> expansion? - # process a block of verbatim text sub verbatim { ## Nothing particular to check @@ -1076,3 +1178,15 @@ sub _preproc_par 1; +__END__ + +=head1 AUTHOR + +Brad Appleton Ebradapp@enteract.comE (initial version), +Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE + +Based on code for B written by +Tom Christiansen Etchrist@mox.perl.comE + +=cut + diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm index 7544fb7..2f89cb9 100644 --- a/lib/Pod/InputObjects.pm +++ b/lib/Pod/InputObjects.pm @@ -11,7 +11,7 @@ package Pod::InputObjects; use vars qw($VERSION); -$VERSION = 1.10; ## Current version of this package +$VERSION = 1.11; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm index 2b3734f..00f516e 100644 --- a/lib/Pod/ParseUtils.pm +++ b/lib/Pod/ParseUtils.pm @@ -320,6 +320,16 @@ sub parse { ($alttext, $page, $node) = ($1, $2, $3); $type = 'section'; } + # alttext and page + elsif(m!^(.+?)\s*[|]\s*($page_rx)$!o) { + ($alttext, $page) = ($1, $2); + $type = 'page'; + } + # alttext and "section" + elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) { + ($alttext, $node) = ($1,$2); + $type = 'section'; + } # page and "section" elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) { ($page, $node) = ($1, $2); @@ -350,16 +360,6 @@ sub parse { ($alttext, $page, $node) = ($1, $2, $3); $type = 'item'; } - # alttext and page - elsif(m!^(.+?)\s*[|]\s*($page_rx)$!o) { - ($alttext, $page) = ($1, $2); - $type = 'page'; - } - # alttext and "section" - elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) { - ($alttext, $node) = ($1,$2); - $type = 'section'; - } # alttext and item elsif(m!^(.+?)\s*[|]\s*/(.+)$!) { ($alttext, $node) = ($1,$2); @@ -777,9 +777,9 @@ sub nodes { =item find_node($name) -Look for a node named C<$name> in the object's node list. Returns the -unique id of the node (i.e. the second element of the array stored in -the node arry) or undef if not found. +Look for a node or index entry named C<$name> in the object. +Returns the unique id of the node (i.e. the second element of the array +stored in the node arry) or undef if not found. =back @@ -787,7 +787,10 @@ the node arry) or undef if not found. sub find_node { my ($self,$node) = @_; - foreach(@{$self->{-nodes}}) { + my @search; + push(@search, @{$self->{-nodes}}) if($self->{-nodes}); + push(@search, @{$self->{-idx}}) if($self->{-idx}); + foreach(@search) { if($_->[0] eq $node) { return $_->[1]; # id } @@ -795,6 +798,28 @@ sub find_node { undef; } +=item idx() + +Add an index entry (or a list of them) to the document's index list. Note that +the order is kept, i.e. start with the first node and end with the last. +If no argument is given, the current list of index entries is returned in the +same order the entries have been added. +An index entry can be any scalar, but usually is a pair of string and +unique id. + +=cut + +# The POD index entries +sub idx { + my ($self,@idx) = @_; + if(@idx) { + push(@{$self->{-idx}}, @idx); + return @idx; + } + else { + return @{$self->{-idx}}; + } +} =head1 AUTHOR diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm index 22b3e49..a00f0ee 100644 --- a/lib/Pod/Parser.pm +++ b/lib/Pod/Parser.pm @@ -10,7 +10,7 @@ package Pod::Parser; use vars qw($VERSION); -$VERSION = 1.10; ## Current version of this package +$VERSION = 1.11; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# @@ -1062,7 +1062,7 @@ sub parse_from_filehandle { next unless (($textline =~ /^(\s*)$/) && (length $paragraph)); ## Issue a warning about any non-empty blank lines - if ( length($1) > 1 ) { + if (length($1) > 1 and ! $self->{_CUTTING}) { my $errorsub = $self->errorsub(); my $file = $self->input_file(); my $errmsg = "*** WARNING: line containing nothing but whitespace". diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm index 230dc8f..53e27e5 100644 --- a/lib/Pod/Select.pm +++ b/lib/Pod/Select.pm @@ -10,7 +10,7 @@ package Pod::Select; use vars qw($VERSION); -$VERSION = 1.10; ## Current version of this package +$VERSION = 1.11; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index 84a936e..b8abe7d 100644 --- a/lib/Pod/Usage.pm +++ b/lib/Pod/Usage.pm @@ -10,7 +10,7 @@ package Pod::Usage; use vars qw($VERSION); -$VERSION = 1.10; ## Current version of this package +$VERSION = 1.11; ## Current version of this package require 5.004; ## requires this Perl version or later =head1 NAME diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t index bec2a19..ec632c2 100755 --- a/t/pod/poderrs.t +++ b/t/pod/poderrs.t @@ -10,6 +10,10 @@ my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash my $passed = testpodchecker \%options, $0; exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; +### Deliberately throw in some blank but non-empty lines + +### The above line should contain spaces + __END__ diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr index 2848faa..3e9c42b 100644 --- a/t/pod/poderrs.xr +++ b/t/pod/poderrs.xr @@ -1,33 +1,33 @@ -*** ERROR: Unknown command 'unknown1' at line 21 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence 'Q' at line 25 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence 'A' at line 26 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence 'Y' at line 27 in file pod/poderrs.t -*** ERROR: Unknown interior-sequence 'V' at line 27 in file pod/poderrs.t -*** WARNING: unterminated B<...> at line 31 in file pod/poderrs.t -*** WARNING: unterminated I<...> at line 30 in file pod/poderrs.t -*** WARNING: unterminated C<...> at line 33 in file pod/poderrs.t -*** WARNING: line containing nothing but whitespace in paragraph at line 41 in file pod/poderrs.t -*** ERROR: =item without previous =over at line 48 in file pod/poderrs.t -*** ERROR: =back without previous =over at line 52 in file pod/poderrs.t -*** ERROR: =over on line 56 without closing =back (at head2) at line 60 in file pod/poderrs.t -*** ERROR: =end without =begin at line 62 in file pod/poderrs.t -*** ERROR: Nested =begin's (first at line 66:html) at line 68 in file pod/poderrs.t -*** ERROR: =end without =begin at line 72 in file pod/poderrs.t -*** ERROR: nested commands C<...C<...>...> at line 76 in file pod/poderrs.t -*** ERROR: garbled entity E at line 80 in file pod/poderrs.t -*** ERROR: garbled entity E> at line 81 in file pod/poderrs.t -*** ERROR: garbled entity E> at line 82 in file pod/poderrs.t -*** WARNING: collapsing newlines to blanks at line 92 in file pod/poderrs.t -*** ERROR: malformed link L<> : empty link at line 94 in file pod/poderrs.t -*** WARNING: ignoring leading whitespace in link at line 100 in file pod/poderrs.t -*** WARNING: ignoring trailing whitespace in link at line 100 in file pod/poderrs.t -*** ERROR: Spurious character(s) after =back at line 106 in file pod/poderrs.t -*** WARNING: No items in =over (at line 114) / =back list at line 116 in file pod/poderrs.t -*** WARNING: 2 unescaped <> in paragraph at line 118 in file pod/poderrs.t -*** ERROR: unresolved internal link 'begin or begin' at line 86 in file pod/poderrs.t -*** ERROR: unresolved internal link 'end with begin' at line 87 in file pod/poderrs.t -*** ERROR: unresolved internal link 'OoPs' at line 88 in file pod/poderrs.t -*** ERROR: unresolved internal link 'abc def' at line 92 in file pod/poderrs.t -*** ERROR: unresolved internal link 'passwd(5)' at line 99 in file pod/poderrs.t +*** ERROR: Unknown command 'unknown1' at line 25 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'Q' at line 29 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'A' at line 30 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'Y' at line 31 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence 'V' at line 31 in file pod/poderrs.t +*** WARNING: unterminated B<...> at line 35 in file pod/poderrs.t +*** WARNING: unterminated I<...> at line 34 in file pod/poderrs.t +*** WARNING: unterminated C<...> at line 37 in file pod/poderrs.t +*** WARNING: line containing nothing but whitespace in paragraph at line 45 in file pod/poderrs.t +*** ERROR: =item without previous =over at line 52 in file pod/poderrs.t +*** ERROR: =back without previous =over at line 56 in file pod/poderrs.t +*** ERROR: =over on line 60 without closing =back (at head2) at line 64 in file pod/poderrs.t +*** ERROR: =end without =begin at line 66 in file pod/poderrs.t +*** ERROR: Nested =begin's (first at line 70:html) at line 72 in file pod/poderrs.t +*** ERROR: =end without =begin at line 76 in file pod/poderrs.t +*** ERROR: nested commands C<...C<...>...> at line 80 in file pod/poderrs.t +*** ERROR: garbled entity E at line 84 in file pod/poderrs.t +*** ERROR: garbled entity E> at line 85 in file pod/poderrs.t +*** ERROR: garbled entity E> at line 86 in file pod/poderrs.t +*** WARNING: collapsing newlines to blanks at line 96 in file pod/poderrs.t +*** ERROR: malformed link L<> : empty link at line 98 in file pod/poderrs.t +*** WARNING: ignoring leading whitespace in link at line 104 in file pod/poderrs.t +*** WARNING: ignoring trailing whitespace in link at line 104 in file pod/poderrs.t +*** ERROR: Spurious character(s) after =back at line 110 in file pod/poderrs.t +*** WARNING: No items in =over (at line 118) / =back list at line 120 in file pod/poderrs.t +*** WARNING: 2 unescaped <> in paragraph at line 122 in file pod/poderrs.t +*** ERROR: unresolved internal link 'begin or begin' at line 90 in file pod/poderrs.t +*** ERROR: unresolved internal link 'end with begin' at line 91 in file pod/poderrs.t +*** ERROR: unresolved internal link 'OoPs' at line 92 in file pod/poderrs.t +*** ERROR: unresolved internal link 'abc def' at line 96 in file pod/poderrs.t +*** ERROR: unresolved internal link 'passwd(5)' at line 103 in file pod/poderrs.t *** WARNING: multiple occurence of link target 'oops' at line - in file pod/poderrs.t pod/poderrs.t has 22 pod syntax errors. -- 1.8.3.1