I've been working on a personal project lately and I decided that, amongst other things, I was going to use PostgreSQL. Some of you may recall that I had an interesting testing strategy for MySQL. The basic idea is that I don't want to teardown and rebuild the database for every test. Truncating a table is generally much faster than dropping and recreating it. However, if I leave the database up, how do I guarantee it's always in a pristine state? One way is to use transactions and always roll them back at the end of a test. That means, amongst other things, that I can't easily test "commit". You can make it work with nested transactions (if your database supports them), but "rollback" can cause issues.

There's also the problem that by breaking "commit", you're altering the behavior of your code somewhat. Plus, if you have more than one process, unless you can share the database handle, separate processes can't see what's happening in another's transaction.

My strategy is not one that everyone is comfortable with, but I prefer to track the changes to the database and simply truncate tables which have changed, possibly restoring the "static" data which some tables need to have when the app is launched. Making this work with PostgreSQL really helped me to relearn a lof things I had forgotten about this excellent database. Here's the full code, with some interesting goodies you may not have expected (plus some hacks I need to fix at some point).

package Testing::Veure; use Modern::Perl; use Moose; use YAML::Tiny; use aliased 'Test::WWW::Mechanize::Catalyst' => 'Mech'; # Mysql prototype: http://use.perl.org/~Ovid/journal/37412 use Readonly; Readonly my $TEST_DB_CONF => 't/conf/db.yml'; Readonly my $PREFIX => '_test_'; Readonly my $CHANGES => "${PREFIX}changed_table"; has schema => ( is => 'rw', isa => 'Veure::Schema' ); has dbh => ( is => 'rw', isa => 'DBI::db' ); has tables => ( is => 'rw', isa => 'HashRef' ); has static_tables => ( is => 'rw', isa => 'ArrayRef' ); has dynamic_tables => ( is => 'rw', isa => 'ArrayRef' ); has debug => ( is => 'ro', isa => 'Bool' ); has mech => ( is => 'ro', isa => Mech, default => sub { Mech->new( catalyst_app => 'Veure' ); } ); has _should_rebuild => ( is => 'rw', isa => 'Bool' ); has _config => ( is => 'rw', isa => 'HashRef' ); use Veure; use mro (); use feature (); BEGIN { my $config = Veure->config->{database}{test}; Veure::Model::DB->config( schema_class => $config->{schema_class}, connect_info => { dsn => $config->{dsn}, user => $config->{user}, password => $config->{password}, } ); } sub import { my ($class, @args) = @_; my $caller = caller; warnings->import(); strict->import(); feature->import(':5.10'); mro::set_mro( scalar caller(), 'c3' ); eval "package $caller; use Test::Most \@args"; } sub BUILD { my $self = shift; my $model = Veure::Model::DB->new; $self->schema( $model->schema ); $self->dbh( $model->schema->storage->dbh ); $self->setup; return $self; } sub setup { my ($self) = @_; my $dbh = $self->dbh; $self->_set_tables; # eventually we'll want sanity checks on triggers if ( $self->_should_rebuild ) { $self->_rebuild_test_database; } else { $self->_refresh_test_database; } return $self; } sub _set_passwords { my $self = shift; my $users = $self->schema->resultset('Users'); while ( my $user = $users->next ) { $user->password('test'); $user->update; } } sub _refresh_test_database { my $self = shift; my $dbh = $self->dbh; my $changes = $dbh->selectall_arrayref(<<" END") or die $dbh->errstr; SELECT table_name, is_static FROM $CHANGES WHERE inserts > 0 OR updates > 0 OR deletes > 0 END my ( $static, @dynamic ); foreach my $change (@$changes) { my ( $table, $is_static ) = @$change; if ($is_static) { $static = 1; # only needs to happen once } else { push @dynamic => $table; } } my @tables = @dynamic; if ($static) { push @tables => @{ $self->static_tables }; } return unless @tables; { local $" = ', '; my $sql = "TRUNCATE TABLE @tables"; warn $sql if $self->debug; $dbh->do($sql) or die $dbh->errstr; } if ($static) { my $sql = "BEGIN;

"; foreach my $table ( @{ $self->static_tables } ) { my $backup = "$PREFIX$table"; $sql .= <<" END_SQL"; INSERT INTO $table (SELECT * FROM $backup); END_SQL } $sql .= "COMMIT;

"; warn $sql if $self->debug; $dbh->do($sql) or die $dbh->errstr; } my $sql = <<" END"; UPDATE $CHANGES SET inserts = 0, updates = 0, deletes = 0 END warn $sql if $self->debug; $dbh->do($sql) or die $dbh->errstr; } sub _rebuild_test_database { my $self = shift; $self->_set_passwords; $self->_create_change_table; my $dbh = $self->dbh; my @static_tables = @{ $self->static_tables }; my @dynamic_tables = @{ $self->dynamic_tables }; # now make thebackups foreach my $table (@static_tables) { my $sql = "CREATE TABLE $PREFIX$table AS SELECT * FROM $table"; warn $sql if $self->debug; $dbh->do($sql) or die $dbh->errstr; } { # doing it this way means we don't need to disable foreign keys local $" = ', '; my $sql = "TRUNCATE TABLE @dynamic_tables"; warn $sql if $self->debug; $dbh->do($sql) or die $dbh->errstr; } $self->_add_triggers_and_records; return $self; } sub _add_triggers_and_records { my $self = shift; $self->_add_changed_table_data( $self->static_tables, 1 ); $self->_add_changed_table_data( $self->dynamic_tables, 0 ); } sub _add_changed_table_data { my ( $self, $tables, $is_static ) = @_; my $dbh = $self->dbh; foreach my $action (qw/insert update delete/) { my $function = <<" END_SQL"; CREATE OR REPLACE FUNCTION fn_${action}_changes () RETURNS TRIGGER AS \$\$ BEGIN UPDATE $CHANGES SET ${action}s = ${action}s + 1 WHERE table_name = TG_ARGV[0]; RETURN NEW; END; \$\$ LANGUAGE plpgsql; END_SQL warn $function if $self->debug; $dbh->do($function) or die $dbh->errstr; warn "---------------- Function for '$action' succeeded" if $self->debug; } foreach my $table (@$tables) { $dbh->do( "INSERT INTO $CHANGES (table_name, is_static) VALUES (?, ?)", undef, $table, $is_static ); foreach my $action (qw/insert update delete/) { my $trigger = <<" END_SQL"; CREATE TRIGGER tr_${action}_$table AFTER $action ON $table FOR EACH ROW EXECUTE PROCEDURE fn_${action}_changes('$table') END_SQL warn $trigger if $self->debug; $dbh->do($trigger) or die $dbh->errstr; warn "---------------- Trigger for '$action' succeeded" if $self->debug; } } } sub _set_tables { my $self = shift; my $dbh = $self->dbh; my $sql = <<' END'; SELECT c.relname FROM pg_catalog.pg_class c LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace WHERE c.relkind IN ('r','') AND n.nspname NOT IN ('pg_catalog', 'pg_toast') AND pg_catalog.pg_table_is_visible(c.oid) AND c.relname <> 'dbix_migration' END my %count_for; foreach my $table ( @{ $dbh->selectcol_arrayref($sql) } ) { my $result = $dbh->selectcol_arrayref("SELECT count(*) FROM $table"); # a naive solution: if we have data when the database is created, it's # static data $count_for{$table} = $result->[0]; } if ( !exists $count_for{$CHANGES} ) { # we're starting with a fresh DB, so assume that if a table has data, # it's a static table my $yaml = YAML::Tiny->new; $yaml->[0] = \%count_for; $yaml->write($TEST_DB_CONF); $self->_should_rebuild(1); } else { my $yaml = YAML::Tiny->read($TEST_DB_CONF); %count_for = %{ $yaml->[0] }; } $self->static_tables( [ grep { $count_for{$_} } keys %count_for ] ); $self->dynamic_tables( [ grep { !$count_for{$_} } keys %count_for ] ); } sub _create_change_table { my $self = shift; my $dbh = $self->dbh; $dbh->do(<<" END"); CREATE TABLE $CHANGES ( id SERIAL PRIMARY KEY, table_name VARCHAR(30) NOT NULL, is_static INTEGER NOT NULL DEFAULT 0, inserts INTEGER NOT NULL DEFAULT 0, updates INTEGER NOT NULL DEFAULT 0, deletes INTEGER NOT NULL DEFAULT 0 ) END } 1;

With this, when you write a test program, you start with this:

# Veure is a placeholder name use Testing::Veure 'no_plan';

With that, you automatically get the benefits of Modern::Perl (I copied the code) and you automatically import the test behavior from Test::Most. If I hadn't done that interesting diddling with Testing::Veure::import() , every test program would have started with this:

use Modern::Perl; use Test::Most 'no_plan'; use Testing::Veure;

I don't like boilerplate, so I decided it had to go away.

To get a pristine test database, just call the constructor:

my $test = Testing::Veure->new; my $mech = $test->mech; # Test::WWW::Mechanize::Catalyst object my $schema = $test->schema; # DBIx::Class my $dbh = $test->dbh; # change as much as you want in the database $test = Testing::Veure->new; # congrats. The db is reset to its pristine condition

The code still needs a lot of work, but there were several things I appreciated.

First, I didn't have to disable foreign keys at all because PostgreSQL allows the following:

TRUNCATE TABLE table1, table2, ... tableN

If those tables have interdependent keys, it will happily truncate them for you. Another nice feature was discovering that when misspelling a table name in a PostgreSQL trigger or function, it will tell you at compile time, unlike with MySQL.

We also assume that any tables with data in them when we're first adding the test tables are "static" data which must be refreshed every time the constructor is called. I use YAML::Tiny to cache them. This is a decision that I will likely have to revisit.

And if you're curious, here are my (stub) tests for this:

#!/usr/bin/env perl use lib 't/lib'; use Testing::Veure tests => 4; my $DEBUG = 0; my $REBUILD = 0; if ($REBUILD) { system('./util/recreate_db') == 0 or die "Could not recreate database: $?"; } my $CHANGES = <<'END'; SELECT table_name FROM _test_changed_table WHERE inserts > 0 OR updates > 0 OR deletes > 0 END subtest 'new database' => sub { my $test = Testing::Veure->new( { debug => $DEBUG } ); my $schema = $test->schema; isa_ok $schema, 'Veure::Schema'; can_ok $test, 'dbh'; isa_ok my $dbh = $test->dbh, 'DBI::db', '... and the object it returns'; ok grep( { $_ eq 'star' } @{ $test->static_tables } ), 'Basic sanity on static tables'; ok grep( { $_ eq 'email' } @{ $test->dynamic_tables } ), 'Basic sanity on dynamic tables'; my $tables = $dbh->selectcol_arrayref($CHANGES); ok !@$tables, 'No tables start out changed'; $dbh->do("INSERT INTO email (from_id, to_id, message) VALUES (1,1,'boo!')"); $tables = $dbh->selectall_arrayref($CHANGES); eq_or_diff $tables, [ ['email'] ], '... but if we change a table, we should see the change'; $dbh->do("INSERT INTO roles (role) VALUES ('booboo')"); $tables = $dbh->selectall_arrayref($CHANGES); eq_or_diff $tables, [ ['email'], ['roles'] ], '... even if we change multiple tables'; done_testing; }; subtest 'refresh_db' => sub { ok my $test = Testing::Veure->new, 'We should be able to reconnect to the test database'; my $dbh = $test->dbh; my $tables = $dbh->selectcol_arrayref($CHANGES); ok !@$tables, 'No tables start out changed'; $dbh->do("INSERT INTO email (from_id, to_id, message) VALUES (1,1,'boo!')"); $tables = $dbh->selectall_arrayref($CHANGES); eq_or_diff $tables, [ ['email'] ], '... but if we change a table, we should see the change'; $dbh->do("INSERT INTO roles (role) VALUES ('booboo')"); $tables = $dbh->selectall_arrayref($CHANGES); eq_or_diff $tables, [ ['email'], ['roles'] ], '... even if we change multiple tables'; done_testing; }; subtest passwords => sub { my $test = Testing::Veure->new; my $users = $test->schema->resultset('Users'); while ( my $user = $users->next ) { ok $user->check_password('test'), 'Passwords should all be changed to test'; } done_testing; }; subtest mechanize => sub { my $test = Testing::Veure->new; can_ok $test, 'mech'; isa_ok my $mech = $test->mech, 'Test::WWW::Mechanize::Catalyst', '... and the object it returns'; $mech->get_ok('/', '... and it should be able to fetch pages'); done_testing; };

I'm working as hard as I can to make writing tests as easy as possible to ensure that I don't have to revisit this later. Dealing with cumbersome test suites is a serious drain on productivity.

Next, I'm going to try to work out a solution with Test::Class which will allow me to do this:

package Testing::Something; use parent 'My::Test::Class'; sub some_tests : Tests { ... }