The idea is that the test suite should not change the database (i.e., it should clean up after itself). There are a few problems, though, and I'm trying to think of appropriate strategies to deal with them. The first problem is obvious: those record counts might legitimately change if someone is using the system -- including running tests on another box.

The other problem is more annoying. Because I can specify which tests to exclude, I can do binary searches to narrow down which tests are actually failing, but it would be nice to be able to optionally run the count after every test program is run so the program can tell me where the changes are occurring. Are there any hooks in Test::Harness that allow this? I'm looking for something similar in concept to HARNESS_FILELEAK_IN_DIR which checks after every test whether new files appeared in the directory.

Another problem is that the "changed record count" data only shows up if all tests pass. Is Test::Harness doing something funny with STDOUT that doesn't get cleared up if tests fail?

#!/usr/bin/perl -w
use strict;

use Test::Harness;
use Getopt::Long;
use Pod::Usage;

use TestConnection qw($dbh);
my $sql = <<'END_SQL';
SELECT relname 
FROM   pg_class 
WHERE  relkind = 'r'
END_SQL
my $sth = $dbh->prepare($sql);
$sth->execute;
my %tables;
while (my $table = $sth->fetchrow_array) {
    # assumes that no app tables start with pg_
    unless ('pg_' eq substr $table, 0, 3) {
        $tables{$table} = count_records($table);
    }
}

sub count_records {
    my $table = shift;
    my $sth = $dbh->prepare("SELECT count(*) FROM $table");
    $sth->execute;
    my ($count) = $sth->fetchrow_array;
    $sth->finish;
    return $count;
}

GetOptions(
    'help|?'    => sub { pod2usage(-verbose => 2); exit },
    'verbose!'  => \$Test::Harness::verbose,
    'quiet'     => sub { $Test::Harness::verbose = 0 },
    'fast'      => \$ENV{FAST_TESTS},
    'include=s' => \my @include,
    'exclude=s' => \my @exclude
);

@include = map { glob } @include;
@exclude = map { glob } @exclude;

BEGIN {
    chdir 't' if -d 't';
}

my @files = @include;

unless (@files) {
    @files = glob "*.t";
}

my @tests;
foreach my $file ( sort @files ) {
    push @tests => $file unless grep { /\Q$file\E/ } @exclude;
}
runtests( @tests );

print "\n\n";
foreach my $table (sort keys %tables) {
    my $count = count_records($table);
    unless ($count == $tables{$table}) {
        print "$table started with $tables{$table} records and ended w
+ith $count records\n";
    }
}
__DATA__
POD snipped
[download]

Cheers,
Ovid

New address of my CGI Course.
Silence is Evil (feel free to copy and distribute widely - note copyright text)