Ovid

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

The idea being that I should just be able to use the appropriate parent class and get proper Modern::Perl and Test::Most behavior without having to specify them in every test class. That one is going to be a bit trickier.