X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FChecker.pm;h=e899f59031d0ca6e0126ca229458d30188cce8a7;hb=4e592f10f45677b2800948f688180c0f1ee587b4;hp=d6fbfff9922e3bb23b98daca843a79df750df102;hpb=5c9f27e7099232f914ab83e4d2976909461a54a8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index d6fbfff..e899f59 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -10,7 +10,7 @@
 package Pod::Checker;
 
 use vars qw($VERSION);
-$VERSION = 1.2;  ## Current version of this package
+$VERSION = 1.4301;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 use Pod::ParseUtils; ## for hyperlinks and lists
@@ -53,13 +53,11 @@ trigger additional warnings. See L<"Warnings">.
 
 B<podchecker> will perform syntax checking of Perl5 POD format documentation.
 
-I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!>
+Curious/ambitious users are welcome to propose additional features they wish
+to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
+consistent with L<perlpod>.
 
-It is hoped that curious/ambitious user will help flesh out and add the
-additional features they wish to see in B<Pod::Checker> and B<podchecker>
-and verify that the checks are consistent with L<perlpod>.
-
-The following checks are currently preformed:
+The following checks are currently performed:
 
 =over 4
 
@@ -84,7 +82,7 @@ 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 *
 
@@ -144,7 +142,7 @@ There is no specification of the formatter after the C<=for> command.
 =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>"
@@ -202,10 +200,11 @@ These may not necessarily cause trouble, but indicate mediocre style.
 
 =over 4
 
-=item * multiple occurence of link target I<name>
+=item * multiple occurrence 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.
+This warning is printed only with warning level greater than one.
 
 =item * line containing nothing but whitespace in paragraph
 
@@ -235,7 +234,7 @@ 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
+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.
 
@@ -274,11 +273,16 @@ The NAME section (C<=head1 NAME>) should consist of a single paragraph
 with the script/module name, followed by a dash `-' and a very short
 description of what the thing is good for.
 
+=item * =headI<n> without preceding higher level
+
+For example if there is a C<=head2> in the POD file prior to a
+C<=head1>.
+
 =back
 
 =head2 Hyperlinks
 
-There are some warnings wrt. malformed hyperlinks.
+There are some warnings with respect to malformed hyperlinks:
 
 =over 4
 
@@ -290,7 +294,7 @@ LE<lt>...E<gt>.
 =item * (section) in '$page' deprecated
 
 There is a section detected in the page name of LE<lt>...E<gt>, e.g.
-C<LE<gt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only.
+C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only.
 Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able
 to expand this to appropriate code. For links to (builtin) functions,
 please say C<LE<lt>perlfunc/mkdirE<gt>>, without ().
@@ -314,7 +318,7 @@ there were no POD commands at all found in the file.
 
 =head1 EXAMPLES
 
-I<[T.B.D.]>
+See L</SYNOPSIS>
 
 =head1 INTERFACE
 
@@ -324,6 +328,13 @@ 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 PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>
+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)
+get the well-known behavior.
+
 =cut
 
 #############################################################################
@@ -353,6 +364,7 @@ my %VALID_COMMANDS = (
     'for'    =>  1,
     'begin'  =>  1,
     'end'    =>  1,
+    'encoding' => '1',
 );
 
 my %VALID_SEQUENCES = (
@@ -548,6 +560,7 @@ sub initialize {
     ## Initialize number of errors, and setup an error function to
     ## increment this number and then print to the designated output.
     $self->{_NUM_ERRORS} = 0;
+    $self->{_NUM_WARNINGS} = 0;
     $self->{-quiet} ||= 0;
     # set the error handling subroutine
     $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror');
@@ -609,9 +622,13 @@ sub poderror {
     ## Increment error count and print message "
     ++($self->{_NUM_ERRORS}) 
         if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
-    my $out_fh = $self->output_handle() || \*STDERR;
-    print $out_fh ($severity, $msg, $line, $file, "\n")
-      if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
+    ++($self->{_NUM_WARNINGS})
+        if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
+    unless($self->{-quiet}) {
+      my $out_fh = $self->output_handle() || \*STDERR;
+      print $out_fh ($severity, $msg, $line, $file, "\n")
+        if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
+    }
 }
 
 ##################################
@@ -628,6 +645,18 @@ sub num_errors {
 
 ##################################
 
+=item C<$checker-E<gt>num_warnings()>
+
+Set (if argument specified) and retrieve the number of warnings found.
+
+=cut
+
+sub num_warnings {
+   return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS};
+}
+
+##################################
+
 =item C<$checker-E<gt>name()>
 
 Set (if argument specified) and retrieve the canonical name of POD as
@@ -646,7 +675,7 @@ sub name {
 
 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
+their occurrence. They consist of plain text, each piece of whitespace is
 collapsed to a single blank.
 
 =cut
@@ -695,7 +724,7 @@ sub idx {
 =item C<$checker-E<gt>hyperlink()>
 
 Add (if argument specified) and retrieve the hyperlinks (as defined by
-C<LE<lt>E<gt>>) of the current POD. They consist of an 2-item array: line
+C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line
 number and C<Pod::Hyperlink> object.
 
 =back
@@ -719,10 +748,8 @@ sub end_pod {
     ## 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') {
@@ -763,26 +790,17 @@ sub end_pod {
 
     # 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,
+    if($self->{-warnings} && $self->{-warnings}>1) {
+      foreach(grep($self->{_unique_nodes}->{$_} > 1,
+        keys %{$self->{_unique_nodes}})) {
+          $self->poderror({ -line => '-', -file => $infile,
             -severity => 'WARNING',
-            -msg => "multiple occurence of link target '$_'"});
+            -msg => "multiple occurrence 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";
-    }
+    # no POD found here
+    $self->num_errors(-1) if($self->{_commands} == 0);
 }
 
 # check a POD command directive
@@ -907,17 +925,24 @@ sub command {
             }
         }
         elsif($cmd =~ /^head(\d+)/) {
+            my $hnum = $1;
+            $self->{"_have_head_$hnum"}++; # count head types
+            if($hnum > 1 && !$self->{"_have_head_".($hnum -1)}) {
+              $self->poderror({ -line => $line, -file => $file,
+                   -severity => 'WARNING', 
+                   -msg => "=head$hnum without preceding higher level"});
+            }
             # check whether the previous =head section had some contents
             if(defined $self->{_commands_in_head} &&
               $self->{_commands_in_head} == 0 &&
               defined $self->{_last_head} &&
-              $self->{_last_head} >= $1) {
+              $self->{_last_head} >= $hnum) {
                 $self->poderror({ -line => $line, -file => $file,
                      -severity => 'WARNING', 
                      -msg => "empty section in previous paragraph"});
             }
             $self->{_commands_in_head} = -1;
-            $self->{_last_head} = $1;
+            $self->{_last_head} = $hnum;
             # check if there is an open list
             if(@{$self->{_list_stack}}) {
                 my $list;
@@ -1051,17 +1076,17 @@ sub _check_ptree {
     foreach(@$ptree) {
         # regular text chunk
         unless(ref) {
-            my $count;
             # count the unescaped angle brackets
             # complain only when warning level is greater than 1
-            my $i = $_;
-            if($count = $i =~ tr/<>/<>/) {
+            if($self->{-warnings} && $self->{-warnings}>1) {
+              my $count;
+              if($count = tr/<>/<>/) {
                 $self->poderror({ -line => $line, -file => $file,
                      -severity => 'WARNING', 
-                     -msg => "$count unescaped <> in paragraph" })
-                if($self->{-warnings} && $self->{-warnings}>1);
+                     -msg => "$count unescaped <> in paragraph" });
+                }
             }
-            $text .= $i;
+            $text .= $_;
             next;
         }
         # have an interior sequence
@@ -1079,7 +1104,7 @@ sub _check_ptree {
         }
         if($nestlist =~ /$cmd/) {
             $self->poderror({ -line => $line, -file => $file,
-                 -severity => 'ERROR', 
+                 -severity => 'WARNING', 
                  -msg => "nested commands $cmd<...$cmd<...>...>"});
             # _TODO_ should we add the contents anyway?
             # expand it anyway, see below
@@ -1234,8 +1259,10 @@ __END__
 
 =head1 AUTHOR
 
+Please report bugs using L<http://rt.cpan.org>.
+
 Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
-Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
+Marek Rouchal E<lt>marekr@cpan.orgE<gt>
 
 Based on code for B<Pod::Text::pod2text()> written by
 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>