X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FChecker.pm;h=637c415d9da0e69abbc0a11e4e1eb1e1fa331398;hb=4f7806f3e19db049970d6c6265e5b956d1d7f74a;hp=ae32677db1a35c3aa58f551f5df5847c09d20394;hpb=ee8c7f5465f003860e2347a2946abacac39bd9b9;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index ae32677..637c415 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -10,7 +10,7 @@
 package Pod::Checker;
 
 use vars qw($VERSION);
-$VERSION = 1.098;  ## Current version of this package
+$VERSION = 1.40;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 use Pod::ParseUtils; ## for hyperlinks and lists
@@ -44,7 +44,8 @@ This function can take a hash of options:
 
 =item B<-warnings> =E<gt> I<val>
 
-Turn warnings on/off. See L<"Warnings">.
+Turn warnings on/off. I<val> is usually 1 for on, but higher values
+trigger additional warnings. See L<"Warnings">.
 
 =back
 
@@ -149,8 +150,8 @@ C<"">.
 =item * Unknown command "I<CMD>"
 
 An invalid POD command has been found. Valid are C<=head1>, C<=head2>,
-C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, C<=for>, C<=pod>,
-C<=cut>
+C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>,
+C<=for>, C<=pod>, C<=cut>
 
 =item * Unknown interior-sequence "I<SEQ>"
 
@@ -201,7 +202,7 @@ 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.
@@ -212,15 +213,14 @@ 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.
 
+=begin _disabled_
+
 =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).
+=end _disabled_
 
 =item * previous =item has no contents
 
@@ -243,7 +243,8 @@ type of the I<first> C<=item> determines the type of the list.
 
 Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>>
 can potentially cause errors as they could be misinterpreted as
-markup commands.
+markup commands. This is only printed when the -warnings level is
+greater than 1.
 
 =item * Unknown entity
 
@@ -273,11 +274,41 @@ 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 * Hyperlinks
+=item * =headI<n> without preceding higher level
 
-There are some warnings wrt. hyperlinks:
-Leading/trailing whitespace, newlines in hyperlinks,
-brackets C<()>.
+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.
+
+=over 4
+
+=item * ignoring leading/trailing whitespace in link
+
+There is whitespace at the beginning or the end of the contents of 
+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<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 ().
+
+=item * alternative text/node '%s' contains non-escaped | or /
+
+The characters C<|> and C</> are special in the LE<lt>...E<gt> context.
+Although the hyperlink parser does its best to determine which "/" is
+text and which is a delimiter in case of doubt, one ought to escape
+these literal characters like this:
+
+  /     E<sol>
+  |     E<verbar>
 
 =back
 
@@ -307,7 +338,6 @@ use strict;
 use Carp;
 use Exporter;
 use Pod::Parser;
-require VMS::Filespec if $^O eq 'VMS';
 
 use vars qw(@ISA @EXPORT);
 @ISA = qw(Pod::Parser);
@@ -320,6 +350,8 @@ my %VALID_COMMANDS = (
     'cut'    =>  1,
     'head1'  =>  1,
     'head2'  =>  1,
+    'head3'  =>  1,
+    'head4'  =>  1,
     'over'   =>  1,
     'back'   =>  1,
     'item'   =>  1,
@@ -471,7 +503,6 @@ sub podchecker( $ ; $ % ) {
 
     ## Now create a pod checker
     my $checker = new Pod::Checker(%options);
-    $checker->parseopts(-process_cut_cmd => 1, -warnings => 1);
 
     ## Now check the pod document for errors
     $checker->parse_from_file($infile, $outfile);
@@ -486,6 +517,27 @@ sub podchecker( $ ; $ % ) {
 ## Method definitions begin here
 ##-------------------------------
 
+##################################
+
+=over 4
+
+=item C<Pod::Checker-E<gt>new( %options )>
+
+Return a reference to a new Pod::Checker object that inherits from
+Pod::Parser and is used for calling the required methods later. The
+following options are recognized:
+
+C<-warnings =E<gt> num>
+  Print warnings if C<num> is true. The higher the value of C<num>,
+the more warnings are printed. Currently there are only levels 1 and 2.
+
+C<-quiet =E<gt> num>
+  If C<num> is true, do not print any errors/warnings. This is useful
+when Pod::Checker is used to munge POD code into plain text from within
+POD formatters.
+
+=cut
+
 ## sub new {
 ##     my $this = shift;
 ##     my $class = ref($this) || $this;
@@ -501,7 +553,10 @@ 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->errorsub('poderror'); # set the error handling subroutine
+    $self->{_NUM_WARNINGS} = 0;
+    $self->{-quiet} ||= 0;
+    # set the error handling subroutine
+    $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror');
     $self->{_commands} = 0; # total number of POD commands encountered
     $self->{_list_stack} = []; # stack for nested lists
     $self->{_have_begin} = ''; # stores =begin
@@ -511,12 +566,11 @@ sub initialize {
     # print warnings?
     $self->{-warnings} = 1 unless(defined $self->{-warnings});
     $self->{_current_head1} = ''; # the current =head1 block
+    $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings});
 }
 
 ##################################
 
-=over 4
-
 =item C<$checker-E<gt>poderror( @args )>
 
 =item C<$checker-E<gt>poderror( {%opts}, @args )>
@@ -547,7 +601,6 @@ The error level, should be 'WARNING' or 'ERROR'.
 sub poderror {
     my $self = shift;
     my %opts = (ref $_[0]) ? %{shift()} : ();
-    $opts{-file} = VMS::Filespec::unixify($opts{-file}) if (exists($opts{-file}) && $^O eq 'VMS');
 
     ## Retrieve options
     chomp( my $msg  = ($opts{-msg} || "")."@_" );
@@ -562,7 +615,9 @@ 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();
+    ++($self->{_NUM_WARNINGS})
+        if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
+    my $out_fh = $self->output_handle() || \*STDERR;
     print $out_fh ($severity, $msg, $line, $file, "\n")
       if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
 }
@@ -581,6 +636,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
@@ -599,7 +666,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
@@ -648,7 +715,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
@@ -672,7 +739,6 @@ sub end_pod {
     ## print the number of errors found
     my $self   = shift;
     my $infile = $self->input_file();
-    $infile = VMS::Filespec::unixify($infile) if $^O eq 'VMS';
     my $out_fh = $self->output_handle();
 
     if(@{$self->{_list_stack}}) {
@@ -691,12 +757,15 @@ sub end_pod {
     my %nodes;
     foreach($self->node()) {
         $nodes{$_} = 1;
-        if(/^(\S+)\s+/) {
+        if(/^(\S+)\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->idx()) {
+        $nodes{$_} = 3; # index node
+    }
     foreach($self->hyperlink()) {
         my ($line,$link) = @$_;
         # _TODO_ what if there is a link to the page itself by the name,
@@ -718,7 +787,7 @@ sub end_pod {
       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
@@ -746,24 +815,23 @@ sub command {
        $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
                          -msg => "Unknown command '$cmd'" });
     }
-    else {
-        # 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
+    else { # found a valid command
+        $self->{_commands}++; # delete this line if below is enabled again
+
+        ##### following check disabled due to strong request
+        #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
             $arg = $self->interpolate_and_check($paragraph, $line,$file);
             my $indent = 4; # default
             if($arg && $arg =~ /^\s*(\d+)\s*$/) {
                 $indent = $1;
-            } else {
-                $self->poderror({ -line => $line, -file => $file,
-                     -severity => 'WARNING', 
-                     -msg => "No numeric argument for =over"});
             }
             # start a new list
             $self->_open_list($indent,$line,$file);
@@ -859,17 +927,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;
@@ -1005,12 +1080,13 @@ sub _check_ptree {
         unless(ref) {
             my $count;
             # count the unescaped angle brackets
+            # complain only when warning level is greater than 1
             my $i = $_;
             if($count = $i =~ tr/<>/<>/) {
                 $self->poderror({ -line => $line, -file => $file,
                      -severity => 'WARNING', 
                      -msg => "$count unescaped <> in paragraph" })
-                if($self->{-warnings});
+                if($self->{-warnings} && $self->{-warnings}>1);
             }
             $text .= $i;
             next;