X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pod%2Fcheckpods.PL;h=1466fb94d3d644334dc01e76c4ac2277adbe6939;hb=2d997502fd695609fa2064523de2ba2d8d094b6c;hp=ccd78ec9cf09959d49871e381667ad90027fd623;hpb=3e3baf6d63945cb64e829d6e5c70a7d00f3d3d03;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pod/checkpods.PL b/pod/checkpods.PL index ccd78ec..1466fb9 100644 --- a/pod/checkpods.PL +++ b/pod/checkpods.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -12,6 +13,7 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; @@ -37,7 +39,7 @@ print OUT <<'!NO!SUBS!'; # From: Roderick Schertler # To: perl5-porters@africa.nicoh.com # Subject: POD lines with only spaces -# +# # There are some places in the documentation where a POD directive is # ignored because the line before it contains whitespace (and so the # directive doesn't start a paragraph). This patch adds a way to check @@ -46,25 +48,32 @@ print OUT <<'!NO!SUBS!'; # problem currently exists. # # Version 1.00 Original. -# Version 1.01 Andy Dougherty +# Version 1.01 Andy Dougherty # Trivial modifications to output format for easier auto-parsing # Broke it out as a separate function to avoid nasty # Make/Shell/Perl quoting problems, and also to make it easier # to grow. Someone will probably want to rewrite in terms of # some sort of Pod::Checker module. Or something. Consider this # a placeholder for the future. -$exit = $last_blank = 0; +# Version 1.02 Roderick Schertler +# Check for pod directives following any kind of unempty line, not +# just lines of whitespace. + +@directive = qw(head1 head2 item over back cut pod for begin end); +@directive{@directive} = (1) x @directive; + +$exit = $last_unempty = 0; while (<>) { - chop; - if (/^(=\S+)/ && $last_blank) { - printf "%s: line %5d, Non-empty line preceeding directive %s\n", + s/(\012|\015\012|\015)$//; + if (/^=(\S+)/ && $directive{$1} && $last_unempty) { + printf "%s: line %5d, no blank line preceding directive =%s\n", $ARGV, $., $1; $exit = 1; } - $last_blank = /^\s+$/; + $last_unempty = ($_ ne ''); if (eof) { close(ARGV); - $last_blank = 0; + $last_unempty = 0; } } exit $exit @@ -73,3 +82,4 @@ exit $exit close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir;