Qef's Website

I've been hacking on my Perl search engine module, which I will finish off soon, and I started hacking up a test suite. This is mainly to test the stuff which handles character encodings, because it has to work on Perl 5.6 and 5.8, which is a bit of a nightmare to do. It means lots of fiddling and testing things on two different machines at every juncture.

While I was doing this I noticed the existence of podchecker, which is a little command-line Perl program which wraps the Pod::Checker module. It validates the documentation in Perl modules, warning of syntax errors (unknown commands and such). So I added a little test program called 99pod.t to my test suite to check the POD documentation in all my .pm files (it assumes they all live under lib, which seems to be the usual arrangement).

Anyway, this is one test program which might usefully be plugged in to many Perl modules, so the here's the code. It's public domain; do what you want with it. It's fairly simple. The only tricky bit is that you have to tell Pod::Checker to write its error messages to a temporary file and only dump that to STDERR if there were actually any errors. That's to avoid messages about your syntax being OK. I prefer the normal Unix convention of “no output means no problem”.

# Validate the POD documentation in all Perl modules (*.pm) under the 'lib'
# directory.  Prints a warning if no documentation was found (because that
# probably means you should write some).

use strict;
use warnings;
use Test;
use File::Find;
use Pod::Checker;
use File::Temp qw( tempfile );
use IO::File;


# Each test is for a particular '.pm' file, so we need to find how many
# there are before we plan the tests.
my @pm;
find({ wanted => \&wanted, no_chdir => 1 }, 'lib');

sub wanted
{
   return unless -f;
   return unless /\.pm$/;
   push @pm, $_;
}

plan tests => scalar @pm;


foreach (@pm) {
   # Warnings are sent to a temporary file.
   my ($log_file, $log_filename) = tempfile();

   my $s = podchecker($_, $log_file, '-warnings' => 2);
   close $log_file;

   warn "\n$_: no documentation.\n" if $s < 0;
   if ($s > 0) {
      $log_file = IO::File->new($log_filename, 'r')
         or die "$0: error rereading log file '$log_filename': $!\n";
      my $log = do { local $/; <$log_file> };
      warn "\n$log\n";
   }

   ok($s <= 0);
   unlink $log_filename;
}

# vim:ft=perl ts=3 sw=3 expandtab: