| Subject: | Ignore whitespace-only POD sections |
Attached is a patch which adds a "nonwhitespace" option which ignores POD sections that only contain whitespace. This is useful to catch those times that the POD section is inserted, but the developer says "I'll fill this in later."
- Alex
diff -ruP Pod-Coverage-0.17/lib/Pod/Coverage.pm Pod-Coverage-new/lib/Pod/Coverage.pm
--- Pod-Coverage-0.17/lib/Pod/Coverage.pm 2004-11-23 09:21:56.000000000 -0500
+++ Pod-Coverage-new/lib/Pod/Coverage.pm 2005-10-05 19:57:54.000000000 -0400
@@ -87,6 +87,9 @@
If C<pod_from> is supplied, that file is parsed for the documentation,
rather than using Pod::Find
+If C<nonwhitespace> is supplied, then only POD sections which have
+non-whitespace characters will count towards being documented.
+
=cut
sub new {
@@ -105,8 +108,9 @@
];
push @$private, @{ $args{also_private} || [] };
my $trustme = $args{trustme} || [];
+ my $nonwhitespace = $args{nonwhitespace} || undef;
- my $self = bless { @_, private => $private, trustme => $trustme }, $class;
+ my $self = bless { @_, private => $private, trustme => $trustme, nonwhitespace => $nonwhitespace }, $class;
}
=item $object->coverage
@@ -276,6 +280,7 @@
print "requiring '$package'\n" if TRACE_ALL;
eval qq{ require $package };
+ print "require failed with $@\n" if TRACE_ALL and $@;
return if $@;
print "walking symbols\n" if TRACE_ALL;
@@ -321,6 +326,7 @@
print "parsing '$pod_from'\n" if TRACE_ALL;
my $pod = Pod::Coverage::Extractor->new;
+ $pod->{nonwhitespace} = $self->{nonwhitespace};
$pod->parse_from_file( $pod_from, '/dev/null' );
return $pod->{identifiers} || [];
@@ -365,6 +371,7 @@
if ($command eq 'item' || $command =~ /^head(?:2|3|4)/) {
# take a closer look
my @pods = ($text =~ /\s*([^\s\|,\/]+)/g);
+ $self->{recent} = [];
foreach my $pod (@pods) {
print "Considering: '$pod'\n" if debug;
@@ -379,11 +386,19 @@
$pod =~ /(\w+)\s*[;\(]/ and $pod = $1;
print "Adding: '$pod'\n" if debug;
- push @{$self->{identifiers}}, $pod;
+ push @{$self->{$self->{nonwhitespace} ? "recent" : "identifiers"}}, $pod;
}
}
}
+sub textblock {
+ my $self = shift;
+ my ($text, $line_num) = shift;
+ if ($self->{nonwhitespace} and $text =~ /\S/ and $self->{recent}) {
+ push @{$self->{identifiers}}, @{$self->{recent}};
+ $self->{recent} = [];
+ }
+}
1;
diff -ruP Pod-Coverage-0.17/t/09whitespace.t Pod-Coverage-new/t/09whitespace.t
--- Pod-Coverage-0.17/t/09whitespace.t 1969-12-31 19:00:00.000000000 -0500
+++ Pod-Coverage-new/t/09whitespace.t 2005-10-05 20:13:56.000000000 -0400
@@ -0,0 +1,12 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 3;
+use lib 't/lib';
+
+BEGIN {
+ use_ok( 'Pod::Coverage' );
+}
+
+my $obj = new Pod::Coverage package => 'Empty', nonwhitespace => 1;
+isa_ok( $obj, 'Pod::Coverage' );
+is($obj->coverage, 0.5, "Noticed empty pod section");
diff -ruP Pod-Coverage-0.17/t/lib/Empty.pm Pod-Coverage-new/t/lib/Empty.pm
--- Pod-Coverage-0.17/t/lib/Empty.pm 1969-12-31 19:00:00.000000000 -0500
+++ Pod-Coverage-new/t/lib/Empty.pm 2005-10-05 20:13:15.000000000 -0400
@@ -0,0 +1,18 @@
+package Empty;
+
+sub foo {}
+sub bar {}
+
+1;
+__END__
+
+# test module - two subs, one with docs, one with empty pod section
+
+=head2 foo
+
+=head2 bar
+
+bar does things!
+
+=cut
+