#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-

package BucardoTesting;

## Helper module for the Bucardo tests
## Contains shared code for setup and breakdown

use strict;
use warnings;
use utf8;

use Encode qw/ decode /;
use Encode::Locale;
use DBI;
use DBD::Pg;
use Time::HiRes qw/sleep gettimeofday tv_interval/;
use Cwd;
use Data::Dumper;

use vars qw/$SQL $sth $count $COM %dbh/;

my $DEBUG = $ENV{BUCARDO_DEBUG} || 0;

$ENV{BUCARDO_CONFIRM} = 0 if exists $ENV{BUCARDO_CONFIRM};

use base 'Exporter';
our @EXPORT = qw/%tabletype %tabletypemysql %tabletypemariadb %tabletypeoracle %tabletypesqlite
                 %sequences %val
                 compare_tables bc_deeply clear_notices wait_for_notice
                 $location $oldherd_msg $newherd_msg $addtable_msg $deltable_msg $nomatch_msg/;

## Special global vars for munging the data
my (%gsth, %gdbh);

my $dbname = 'bucardo_test';

## We need to use the local Bucardo.pm, not a system installed one!
$ENV{PERL5LIB} = '.';

## Shortcuts for ease of changes and smaller text:
our $addtable_msg = 'Added the following tables or sequences';
our $deltable_msg = 'Removed the following tables';
our $nomatch_msg = 'Did not find matches for the following terms';
our $oldherd_msg = 'The following tables or sequences are now part of the relgroup';
our $newherd_msg = 'The following tables or sequences are now part of the relgroup';

our $location = 'setup';
my $testmsg  = ' ?';
my $testline = '?';
## Sometimes, we want to stop as soon as we see an error
my $bail_on_error = $ENV{BUCARDO_TESTBAIL} || 0;
my $total_errors = 0;
## Used by the tt sub
my %timing;

## If true, turns off the epoch "time" output at the end of each testing output line
my $notime = 1;

my $user = qx{whoami};
chomp $user;

my $FRESHLOG = 1;
if ($FRESHLOG) {
    unlink 'tmp/bucardo.log';
}

my $piddir = 'pid';
if (! -e $piddir) {
    mkdir $piddir;
}

## Test databases are labelled as A, B, C, etc.
my @dbs = qw/A B C D E/;

### TODO: Add point type (which has no natural ordering operator!)

our %tabletype =
    (
     'bucardo_test1'  => 'SMALLINT',
     'bucardo_test2'  => 'INT',
     'Bucardo_test3'  => 'BIGINT',
     'bucardo_test4'  => 'TEXT',
     'bucardo_test5'  => 'DATE',
     'bucardo_test6'  => 'TIMESTAMP',
     'bucardo_test7'  => 'NUMERIC',
     'bucardo_test8'  => 'BYTEA',
     'bucardo_test9'  => 'int_unsigned',
     'bucardo_test10' => 'TIMESTAMPTZ',
     'bucardo space test' => 'INT',
     );

our %tabletypemysql =
    (
     'bucardo_test1'  => 'SMALLINT',
     'bucardo_test2'  => 'INT',
     'Bucardo_test3'  => 'BIGINT',
     'bucardo_test4'  => 'VARCHAR(1000)',
     'bucardo_test5'  => 'DATE',
     'bucardo_test6'  => 'DATETIME',
     'bucardo_test7'  => 'NUMERIC(5,1)',
     'bucardo_test8'  => 'VARBINARY(1000)',
     'bucardo_test9'  => 'INTEGER UNSIGNED',
     'bucardo_test10' => 'DATETIME',
     'bucardo space test' => 'INT',
     );

our %tabletypemariadb =
    (
     'bucardo_test1'  => 'SMALLINT',
     'bucardo_test2'  => 'INT',
     'Bucardo_test3'  => 'BIGINT',
     'bucardo_test4'  => 'VARCHAR(700)',
     'bucardo_test5'  => 'DATE',
     'bucardo_test6'  => 'DATETIME',
     'bucardo_test7'  => 'NUMERIC(5,1)',
     'bucardo_test8'  => 'VARBINARY(1000)',
     'bucardo_test9'  => 'INTEGER UNSIGNED',
     'bucardo_test10' => 'DATETIME',
     'bucardo space test' => 'INT',
     );

our %tabletypeoracle =
    (
     'bucardo_test1'  => 'SMALLINT',
     'bucardo_test2'  => 'INT',
     'Bucardo_test3'  => 'BIGINT',
     'bucardo_test4'  => 'NVARCHAR2(1000)',
     'bucardo_test5'  => 'DATE',
     'bucardo_test6'  => 'TIMESTAMP',
     'bucardo_test7'  => 'NUMERIC(5,1)',
     'bucardo_test8'  => 'BLOB',
     'bucardo_test9'  => 'INTEGER',
     'bucardo_test10' => 'TIMESTAMP WITH TIME ZONE',
     'bucardo space test' => 'INT',
     );

our %tabletypesqlite =
    (
     'bucardo_test1'  => 'SMALLINT',
     'bucardo_test2'  => 'INT',
     'Bucardo_test3'  => 'BIGINT',
     'bucardo_test4'  => 'VARCHAR(1000)',
     'bucardo_test5'  => 'DATE',
     'bucardo_test6'  => 'DATETIME',
     'bucardo_test7'  => 'NUMERIC(5,1)',
     'bucardo_test8'  => 'VARBINARY(1000)',
     'bucardo_test9'  => 'INTEGER UNSIGNED',
     'bucardo_test10' => 'DATETIME',
     'bucardo space test' => 'INT',
     );


our @tables2empty = (qw/droptest_bucardo/);

our %sequences =
    (
    'bucardo_test_seq1' => '',
    'bucardo_test_seq2' => '',
    'Bucardo_test_seq3' => '',
    );

my %debug = (
             recreatedb     => 0,
             recreateschema => 1,
             recreateuser   => 0,
         );

my $DEBUGDIR = ".";
-e $DEBUGDIR or mkdir $DEBUGDIR;

## To avoid stepping on other instance's toes
my $PIDDIR = "/tmp/bucardo_testing_$ENV{USER}";
mkdir $PIDDIR if ! -e $PIDDIR;

## Let pg_config guide us to a likely initdb/pg_ctl location
my $output = qx{pg_config --bindir};
chomp $output;
my $bindir = $output =~ m{^/} ? $1 : '';

## Location of files
my $initdb = $ENV{PGBINDIR} ? "$ENV{PGBINDIR}/initdb" : $bindir ? "$bindir/initdb" : 'initdb';
my $pg_ctl = $ENV{PGBINDIR} ? "$ENV{PGBINDIR}/pg_ctl" : $bindir ? "$bindir/pg_ctl" : 'pg_ctl';

## Get the default initdb location
my $pgversion = qx{$initdb -V};
my ($pg_ver, $pg_major_version, $pg_minor_version, $pg_point_version);
if (defined $pgversion and $pgversion =~ /initdb \(PostgreSQL\) (\d+\..*)/) {
    $pg_ver = $1;
    ($pg_major_version, $pg_minor_version, $pg_point_version) = split /\./, $pg_ver;
    $pg_minor_version =~ s/(\d+).+/$1/;
}
else {
    die qq{Could not determine initdb version information from running "$initdb -V"\n};
}


## Each database can also have a custom version
## We do this by setting PGBINDIR[A-Z]
## This allows us to test (for example) a 8.1 master and an 8.4 slave
my %pgver;
my %clusterinfo;
my $lport = 58920;
for my $name ('A'..'Z') {
    $lport++;
    $clusterinfo{$name}{port} = $lport;

    my $lbindir = $ENV{PGBINDIR} || '';
    my $linitdb = $initdb;
    my $lpgctl  = $pg_ctl;
    my $localver = $pg_ver;
    my ($lmaj,$lmin,$lrev) = ($pg_major_version, $pg_minor_version, $pg_point_version);
    if (exists $ENV{"PGBINDIR$name"}) {
        $lbindir = $ENV{"PGBINDIR$name"};
        -d $lbindir or die qq{Invalid ENV "PGBINDIR$name"\n};
        $linitdb = "$lbindir/initdb";
        $lpgctl = "$lbindir/pg_ctl";

        $COM = "$linitdb -V";
        my $answer = qx{$COM};
        die "Cannot find version from: $COM" if $answer !~ /initdb \(PostgreSQL\) (\d+\..*)/;
        $localver = $1;
        ($lmaj,$lmin,$lrev) = split /\./, $localver;
        $lmin =~ s/(\d+).+/$1/;
    }
    $pgver{$name} = {
        bindir  => $lbindir,
        initdb  => $linitdb,
        pgctl   => $lpgctl,
        version => $localver,
        ver     => "$lmaj.$lmin",
        vmaj    => $lmaj,
        vmin    => $lmin,
        vrev    => $lrev,
        dirname => "bucardo_test_database_${name}_$lmaj.$lmin",
        port    => $lport,
    };
}

# Set a semi-unique name to make killing old tests easier
my $xname = "bctest_$ENV{USER}";

## Maximum time to wait for bucardo to return
my $ALARM_BUCARDO = 25;
## Maximum time to wait for a kid to appear via pg_listener
my $ALARM_WAIT4KID = 3;
## How long to wait for most syncs to take effect?
my $TIMEOUT_SYNCWAIT = 3;
## How long to sleep between checks for sync being done?
my $TIMEOUT_SLEEP = 0.1;
## How long to wait for a notice to be issued?
my $TIMEOUT_NOTICE = 4;

## Bail if the bucardo file does not exist / does not compile
for my $file (qw/bucardo Bucardo.pm/) {
    if (! -e $file) {
        die "Cannot run without file $file\n";
    }
    eval {
        $ENV{BUCARDO_TEST} = 1;
        require $file;
        $ENV{BUCARDO_TEST} = 0;
    };
    if ($@) {
        die "Cannot run unless $file compiles cleanly: $@\n";
    }
}

## Prepare some test values for easy use
## The secondary names are for other databases, e.g. MySQL
our %val;
my $xvalmax = 30;
for (1..$xvalmax) {
    $val{SMALLINT}{$_} = $_;
    $val{INT}{$_} = 1234567+$_;
    $val{BIGINT}{$_} = 7777777777 + $_;
    $val{TEXT}{$_} = $val{'VARCHAR(1000)'}{$_} = "bc'$_";
    $val{DATE}{$_} = sprintf '2001-10-%02d', $_;
    $val{TIMESTAMP}{$_} = $val{DATE}{$_} . ' 12:34:56';
    $val{NUMERIC}{$_} = $val{'NUMERIC(5,1)'}{$_} = 0.7 + $_;
    $val{BYTEA}{$_} = "$_\0Z";
    $val{int_unsigned}{$_} = $val{'INTEGER UNSIGNED'}{$_} = 5000 + $_;
    $val{TIMESTAMPTZ}{$_} = $val{DATETIME}{$_} = $val{DATE}{$_} . ' 11:22:33+00';
    $val{DATETIME}{$_} =~ s/\+00//;
    $val{TIMESTAMPTZNOZERO} = $val{DATE}{$_} . ' 11:22:33';
}


sub diag {
    Test::More::diag(@_);
}


sub new {

    ## Create a new BucardoTesting object.
    ## Arguments:
    ## 1. Hashref of options (optional)
    ## Returns: reference to a new BucardoTesting object

    my $class = shift;
    my $arg   = shift || {};
    my $self  = {};
    bless $self, $class;

    if ($arg->{notime}) {
        $notime = 1;
    }

    ## Make a note of which file invoked us for later debugging
    $self->{file} = (caller)[1];

    ## Bail on first error? Default is ENV, then false.
    $bail_on_error = exists $arg->{bail} ? $arg->{bail} : $ENV{BUCARDO_TESTBAIL} || 0;

    ## Name of the test schema
    $self->{schema} = 'bucardo_schema';

    ## Let's find out where bucardo is. Prefer the blib ones, which are shebang adjusted
    if (-e 'blib/script/bucardo') {
        $self->{bucardo} = 'blib/script/bucardo';
    }
    elsif (-e '../blib/script/bucardo') {
        $self->{bucardo} = '../blib/script/bucardo';
    }
    elsif (-e './bucardo') {
        $self->{bucardo} = './bucardo';
    }
    elsif (-e '../bucardo') {
        $self->{bucardo} = '../bucardo';
    }
    else {
        die qq{Could not find bucardo\n};
    }

    ## Handle both old and new way of setting location
    if ($location eq 'setup' and $arg->{location}) {
        $location = $self->{location} = $arg->{location};
    }


    return $self;

} ## end of new


sub debug {

    ## Simply internal debugging routine, prints a message if $DEBUG is set
    ## Arguments:
    ## 1. Message to print
    ## 2. Optional level, defaults to 0
    ## Returns: nothing

    $DEBUG or return;

    my $msg = shift || 'No message?!';
    my $level = shift || 0;

    return if $DEBUG < $level;

    chomp $msg;
    warn "DEBUG: $msg\n";

    return;

} ## end of debug


sub empty_cluster {

    ## Empty out a cluster's databases
    ## Creates the cluster and 'bucardo_test' database as needed
    ## For existing databases, removes all known schemas
    ## Always recreates the public schema
    ## Arguments: one
    ## 1. Name of the cluster
    ## Returns: arrayref of database handles to the 'bucardo_test*' databases

    my $self = shift;
    my $clustername = shift or die;

    ## Create the cluster if needed
    $self->create_cluster($clustername);

    ## Start it up if needed
    $self->start_cluster($clustername);

    my $alldbh;

    ## Get a handle to the postgres database
    my $masterdbh = $self->connect_database($clustername, 'postgres');

    my $dbh;
    if (database_exists($masterdbh, $dbname)) {
        $dbh = $self->connect_database($clustername, $dbname);
        ## Remove any of our known schemas
        my @slist;
        for my $sname (qw/ public bucardo freezer tschema /) {
            push @slist => $sname if $self->drop_schema($dbh, $sname);
        }
        debug(qq{Schemas dropped from $dbname on $clustername: } . join ',' => @slist);

        ## Recreate the public schema
        $dbh->do("CREATE SCHEMA public");
        $dbh->commit();
    }
    else {
        local $masterdbh->{AutoCommit} = 1;
        debug(qq{Creating database $dbname});
        $masterdbh->do("CREATE DATABASE $dbname");
        $dbh = $self->connect_database($clustername, $dbname);
    }

    $masterdbh->disconnect();

    return $dbh;

} ## end of empty_cluster


sub create_cluster {

    ## Create a cluster if it does not already exist
    ## Runs initdb, then modifies postgresql.conf
    ## Arguments:
    ## 1. Name of the cluster
    ## Returns: nothing

    my $self = shift;
    my $clustername = shift or die;

    my $line = (caller)[2];
    my $info = $pgver{$clustername}
        or die qq{No such cluster as "$clustername" (called from line $line)\n};

    my $dirname = $info->{dirname};

    if (-d $dirname) {
        ## Sometimes these test clusters get left in a broken state.
        my $file = "$dirname/postgresql.conf";
        if (! -e $file) {
            ## Just move it out of the way, rather than deleting it
            rename $dirname, "$dirname.old";
        }
        return;
    }

    my $localinitdb = $info->{initdb};

    debug(qq{Running $localinitdb for cluster "$clustername"});
    my $com = qq{$localinitdb -D $dirname 2>&1};
    debug($com);
    my $res = qx{$com};
    die $res if $? != 0;
    if ($DEBUG) {
        warn Dumper $res;
    }

    ## Make some minor adjustments
    my $connections = $clustername eq 'A' ? 150 : 75;
    my $file = "$dirname/postgresql.conf";
    open my $fh, '>>', $file or die qq{Could not open "$file": $!\n};
    printf {$fh} "

port                       = %d
max_connections            = $connections
random_page_cost           = 2.5
log_statement              = 'all'
log_min_duration_statement = 0
client_min_messages        = WARNING
log_line_prefix            = '%s %s[%s] '
listen_addresses           = ''

",
    $info->{port}, '%m', '%d', '%p';

    ## Make some per-version adjustments
    if ($info->{ver} >= 8.3) {
        print {$fh} "logging_collector = off\n";
    }
    else {
        print {$fh} "redirect_stderr   = off\n";
    }
    close $fh or die qq{Could not close "$file": $!\n};

    return;


} ## end of create_cluster


sub start_cluster {

    ## Startup a cluster if not already running
    ## Arguments:
    ## 1. Name of the cluster
    ## Returns: nothing

    my $self = shift;
    my $clustername = shift || 'A';

    ## Create the cluster if needed
    $self->create_cluster($clustername);

    my $info = $pgver{$clustername};

    my $dirname = $info->{dirname};

    ## Check the PID file. If it exists and is active, simply return
    my $pidfile = "$dirname/postmaster.pid";
    if (-e $pidfile) {
        open my $fh, '<', $pidfile or die qq{Could not open "$pidfile": $!\n};
        <$fh> =~ /(\d+)/ or die qq{No PID found in file "$pidfile"\n};
        my $pid = $1;
        close $fh or die qq{Could not close "$pidfile": $!\n};
        ## An active process should respond to a "ping kill"
        $count = kill 0 => $pid;
        return if 1 == $count;
        ## If no response, remove the pidfile ourselves and go on
        debug(qq{Server seems to have died, removing file "$pidfile"});
        unlink $pidfile or die qq{Could not remove file "$pidfile"\n};
    }

    my $port = $info->{port};
    debug(qq{Starting cluster "$clustername" on port $port});

    ## If not Windows, we'll use Unix sockets with a custom socket dir
    my $option = '';
    if ($^O !~ /Win32/) {
        my $sockdir = "$dirname/socket";
        -e $sockdir or mkdir $sockdir;
        $option = q{-o '-k socket'};
        ## Older versions do not assume socket is right off of data dir
        if ($info->{ver} <= 8.0) {
            $option = qq{-o '-k $dirname/socket'};
        }
    }

    ## Attempt to start it up with a pg_ctl call
    my $localpgctl = $info->{pgctl};

    $COM = qq{$localpgctl $option -l $dirname/pg.log -D $dirname start};
    debug(qq{Running: $COM});
    qx{$COM};

    ## Wait for the pidfile to appear
    my $maxwaitseconds = 20;
    my $loops = 0;
    {
        last if -e $pidfile;
        sleep 0.1;
        if ($loops++ > ($maxwaitseconds * 10)) {
            die "Failed to startup cluster $clustername, command was $COM\n";
        }
        redo;
    }

    ## Keep attempting to get a database connection until we get one or timeout
    $maxwaitseconds = 10;

    my $dbhost = getcwd;
    $dbhost .= "/$dirname/socket";

    ## Using the "invalidname" is a nice way to work around locale issues
    my $dsn = "dbi:Pg:dbname=invalidname;port=$port;host=$dbhost";
    my $dbh;

    debug(qq{Connecting as $dsn});

    $loops = 0;
  LOOP: {
        eval {
            $dbh = DBI->connect($dsn, '', '', { AutoCommit=>0, RaiseError=>1, PrintError=>0 });
        };
        last if $@ =~ /"invalidname"/;
        sleep 0.1;
        if ($loops++ > ($maxwaitseconds * 10)) {
            die "Database did not come up: dsn was $dsn\n";
        }
        redo;
    }

    return;

} ## end of start_cluster


sub connect_database {

    ## Return a connection to a database within a cluster
    ## Arguments:
    ## 1. Name of the cluster
    ## 2. Name of the database (optional, defaults to 'bucardo_test')
    ## Returns: database handle

    my $self = shift;
    my $clustername = shift or die;
    my $ldbname = shift || $dbname;

    ## This may be one of the "extra" databases. In which case the true cluster must be revealed:
    $clustername =~ s/\d+$//;

    ## Create and start the cluster as needed
    $self->start_cluster($clustername);

    ## Build the DSN to connect with
    my $info = $pgver{$clustername};
    my $dbport = $info->{port};
    my $dbhost = getcwd . "/$info->{dirname}/socket";
    my $dsn = "dbi:Pg:dbname=$ldbname;port=$dbport;host=$dbhost";

    ## If we already have a cached version and it responds, return it
    if (exists $dbh{$dsn}) {
        my $dbh = $dbh{$dsn};
        $dbh->ping and return $dbh;
        ## No ping? Remove from the cache
        $dbh->disconnect();
        delete $dbh{$dsn};
    }

    my $dbh;
    eval {
        $dbh = DBI->connect($dsn, '', '', { AutoCommit=>0, RaiseError=>1, PrintError=>0 });
    };
    if ($@) {
        if ($ldbname eq 'postgres' and $@ =~ /"postgres"/) {

            ## Probably an older version that uses template1
            (my $localdsn = $dsn) =~ s/dbname=postgres/dbname=template1/;

            ## Give up right away if we are already trying template1
            die $@ if $localdsn eq $dsn;

            debug(qq{Connection failed, trying to connect to template1 to create a postgres database});

            ## Connect as template1 and create a postgres database
            $dbh = DBI->connect($localdsn, '', '', { AutoCommit=>1, RaiseError=>1, PrintError=>0 });
            $dbh->do('CREATE DATABASE postgres');
            $dbh->disconnect();

            ## Reconnect to our new database
            $dbh = DBI->connect($dsn, '', '', { AutoCommit=>0, RaiseError=>1, PrintError=>0 });
        }
        else {
            die "$@\n";
        }
    }

    $dbh->do(q{SET TIME ZONE 'UTC'});

    if ($DEBUG) {
        my $file = 'bucardo.debug.dsns.txt';
        if (open my $fh, '>>', $file) {
            print {$fh} "\n$dsn\n";
            my ($host,$port,$db);
            $dsn =~ /port=(\d+)/ and $port=$1;
            $dsn =~ /dbname=(.+?);/ and $db=$1;
            $dsn =~ /host=(.+)/ and $host=$1;
            printf {$fh} "psql%s%s%s\n", " -h $host", " -p $port", " $db";
            close $fh or die qq{Could not close file "$file": $!\n};
        }
    }

    $dbh->commit();

    return $dbh;

} ## end of connect_database


sub drop_schema {

    ## Drop a schema if it exists
    ## Two arguments:
    ## 1. database handle
    ## 2. name of the schema
    ## Returns 1 if dropped, 0 if not

    my ($self,$dbh,$sname) = @_;

    return 0 if ! schema_exists($dbh, $sname);

    local $dbh->{AutoCommit} = 1;
    local $dbh->{Warn} = 0;
    $dbh->do("DROP SCHEMA $sname CASCADE");

    return 1;

} ## end of drop_schema


sub repopulate_cluster {

    ## Make sure a cluster is empty, then add in the sample data
    ## Arguments: two
    ## 1. Name of the cluster
    ## 2. Optional - number of additional databases to create
    ## Returns: database handle to the 'bucardo_test' database

    my $self = shift;
    my $clustername = shift or die;
    my $extradbs = shift || 0;

    Test::More::note("Recreating cluster $clustername");

    my $dbh = $self->empty_cluster($clustername);
    $self->add_test_schema($dbh, $clustername);

    ## Now recreate all the extra databases via templating
    for my $number (1..$extradbs) {
        my $dbname2 = "$dbname$number";
        local $dbh->{AutoCommit} = 1;
        if (database_exists($dbh, $dbname2)) {
            ## First, kill other sessions!
            my $odbh = $self->connect_database($clustername, $dbname2);
            eval {
                $SQL = 'SELECT pg_terminate_backend(pid) FROM pg_stat_activity WHERE datname = ? AND pid <> pg_backend_pid()';
                $sth = $odbh->prepare($SQL);
                $odbh->execute($dbname2);
                $odbh->commit();
            };
            $odbh->disconnect();
            $dbh->do("DROP DATABASE $dbname2");
        }
        $dbh->do("CREATE DATABASE $dbname2 TEMPLATE $dbname");
    }

    ## Store our names away
    $gdbh{$clustername} = $dbh;

    return $dbh;

} ## end of repopulate_cluster


sub add_test_schema {

    ## Add an empty test schema to a database
    ## Arguments: two
    ## 1. database handle (usually to 'bucardo_test')
    ## 2. Cluster name
    ## Returns: nothing

    my $self = shift;
    my $dbh = shift or die;
    my $clustername = shift or die;

    my ($tcount,$scount,$fcount) = (0,0,0);

    ## Empty out or create the droptest table
    if (table_exists($dbh => 'droptest_bucardo')) {
        $dbh->do('TRUNCATE TABLE droptest_bucardo');
    }
    else {
        $tcount++;
        $dbh->do(q{
            CREATE TABLE droptest_bucardo (
              name TEXT NOT NULL,
              type TEXT NOT NULL
            )
        });
    }

    ## Create the language if needed
    if (!language_exists($dbh => 'plpgsql')) {
        debug(q{Creating language plpgsql});
        $dbh->do('CREATE LANGUAGE plpgsql');
    }

    ## Create supporting functions as needed
    if (!function_exists($dbh => 'trigger_test')) {
        $fcount++;
        $dbh->do(q{
                CREATE FUNCTION trigger_test()
                RETURNS trigger
                LANGUAGE plpgsql
                AS $_$ BEGIN
                INSERT INTO droptest_bucardo(name,type)
                    VALUES (TG_RELNAME, 'trigger');
                RETURN NULL;
                END;
                $_$
            });
    }
    if (!function_exists($dbh => 'trigger_test_zero')) {
        $fcount++;
        $dbh->do(q{
                CREATE FUNCTION trigger_test_zero()
                RETURNS trigger
                LANGUAGE plpgsql
                AS $_$ BEGIN
                INSERT INTO droptest_bucardo(name,type)
                    VALUES (TG_RELNAME, 'trigger');
                RETURN NULL;
                END;
                $_$;
            });
    }

    ## Create our helper domain for pseudo-types
    if (domain_exists($dbh => 'int_unsigned')) {
        $dbh->do('DROP DOMAIN int_unsigned CASCADE');
    }
    $dbh->do('CREATE DOMAIN int_unsigned INTEGER CHECK (value >= 0)');

    ## Create one table for each table type
    for my $table (sort keys %tabletype) {

        local $dbh->{Warn} = 0;

        ## Does the table already exist? If so, drop it.
        if (table_exists($dbh => $table)) {
            $dbh->do(qq{DROP TABLE "$table"});
        }

        my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
        my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
        $SQL = qq{
            CREATE TABLE "$table" (
                $pkeyname    $tabletype{$table} NOT NULL $pkindex};
        $SQL .= $table =~ /X/ ? "\n)" : qq{,
                data1 TEXT                   NULL,
                inty  SMALLINT               NULL,
                booly BOOLEAN                NULL,
                bite1 BYTEA                  NULL,
                bite2 BYTEA                  NULL,
                email TEXT                   NULL UNIQUE
            )
            };

        $dbh->do($SQL);
        $tcount++;

        if ($table =~ /test2/) {
            $dbh->do(qq{ALTER TABLE "$table" ADD CONSTRAINT multipk PRIMARY KEY ($pkeyname,data1)});
        }

        ## Create a trigger to test trigger supression during syncs
        $SQL = qq{
            CREATE TRIGGER "bctrig_$table"
            AFTER INSERT OR UPDATE ON "$table"
            FOR EACH ROW EXECUTE PROCEDURE trigger_test()
            };
        $table =~ /0/ and ($SQL =~ s/trigger_test/trigger_test_zero/);
        $dbh->do($SQL);

        ## Create a rule to test rule supression during syncs
        $SQL = qq{
            CREATE OR REPLACE RULE "bcrule_$table"
            AS ON INSERT TO "$table"
            DO ALSO INSERT INTO droptest_bucardo(name,type) VALUES ('$table','rule')
            };
        $table =~ /0/ and $SQL =~ s/NEW.inty/0/;
        $dbh->do($SQL);
    }

    ## Create the foreign key tables
    #$dbh->do('CREATE TABLE bucardo_fkey1 (fkid INTEGER NOT NULL PRIMARY KEY, data2 TEXT)');
    $SQL = q{
ALTER TABLE bucardo_fkey1
  ADD CONSTRAINT "bucardo_fkey1"
  FOREIGN KEY (fkid)
  REFERENCES bucardo_test1 (id)
  ON DELETE CASCADE ON UPDATE CASCADE
};
    #$dbh->do($SQL);

    ## Create one sequence for each table type
    for my $seq (sort keys %sequences) {

        local $dbh->{Warn} = 0;

        ## Does the sequence already exist? If so, drop it.
        if (table_exists($dbh => $seq)) {
            $dbh->do(qq{DROP SEQUENCE "$seq"});
        }

        $SQL = qq{CREATE SEQUENCE "$seq"};
        $dbh->do($SQL);
        $scount++;
    }

    debug("Test objects created for $clustername. Tables: $tcount  Sequences: $scount  Functions: $fcount");
#    diag("Test objects created for $clustername. Tables: $tcount  Sequences: $scount  Functions: $fcount");

    $dbh->commit() if ! $dbh->{AutoCommit};

    return;

} ## end of add_test_schema

sub mock_serialization_failure {
    my ($self, $dbh, $table) = @_;
    return if $dbh->{pg_server_version} < 80401;
    $table ||= 'bucardo_test1';

    # Mock a serialization failure on every other INSERT. Runs only when
    # `session_replica_role` is "replica", which it true for Bucardo targets.
    $dbh->do(qq{
        DROP SEQUENCE IF EXISTS serial_seq;
        CREATE SEQUENCE serial_seq;

        CREATE OR REPLACE FUNCTION mock_serial_fail(
        ) RETURNS trigger LANGUAGE plpgsql AS \$_\$
        BEGIN
            IF nextval('serial_seq') % 2 = 0 THEN RETURN NEW; END IF;
            RAISE EXCEPTION 'Serialization error'
                  USING ERRCODE = 'serialization_failure';
        END;
        \$_\$;

        CREATE TRIGGER mock_serial_fail AFTER INSERT ON "$table"
            FOR EACH ROW EXECUTE PROCEDURE mock_serial_fail();
        ALTER TABLE "$table" ENABLE REPLICA TRIGGER mock_serial_fail;
    });
    $dbh->commit;

    return 1;
} ## end of mock_serialization_failure

sub unmock_serialization_failure {
    my ($self, $dbh, $table) = @_;
    return if $dbh->{pg_server_version} < 80401;
    $table ||= 'bucardo_test1';

    $dbh->do(qq{
        DROP TRIGGER IF EXISTS mock_serial_fail ON "$table";
        DROP FUNCTION IF EXISTS mock_serial_fail();
        DROP SEQUENCE IF EXISTS serial_seq;
    });

    return 1;
} ## end of unmock_serialization_failure

sub add_test_databases {

    ## Add one or more databases to the bucardo.db table
    ## Arguments:
    ## 1. White-space separated db names
    ## Returns: nothing

    my $self = shift;
    my $string = shift or die;

    for my $db (split /\s+/ => $string) {
        my $ctlargs = $self->add_db_args($db);
        my $i = $self->ctl("add database bucardo_test $ctlargs");
        die $i if $i =~ /ERROR/;
    }

    return;

} ## end of add_test_databases


sub add_db_args {

    ## Arguments:
    ## 1. Name of a cluster
    ## Returns: DSN-like string to connect to that cluster
    ## Allows for "same" databases o the form X# e.g. A1, B1
    ## May return string or array depending on how it was called

    my $self = shift;
    my $clustername = shift or die;

    $clustername =~ s/\d+$//;

    ## Build the DSN to connect with
    my $info = $pgver{$clustername};
    my $dbport = $info->{port};
    my $dbhost = getcwd . "/$info->{dirname}/socket";
    my $dsn = "dbi:Pg:dbname=$dbname;port=$dbport;host=$dbhost";

    return wantarray
        ? ($user,$dbport,$dbhost)
        : "name=$dbname user=$user port=$dbport host=$dbhost";

} ## end of add_db_args


sub stop_bucardo {

    ## Stops Bucardo via a bucardo request
    ## Arguments: none
    ## Returns: 1

    my $self = shift;

    $self->ctl('stop testing');

    sleep 0.2;

    return 1;

} ## end of stop_bucardo


sub ctl {

    ## Run a simple non-forking command against bucardo
    ## Emulates a command-line invocation
    ## Arguments:
    ## 1. String to pass to bucardo
    ## 2. Database name to connect to. Used only when we're not confident the bucardo database exists already.
    ## Returns: answer as a string

    my ($self,$args, $db) = @_;
    $db ||= 'bucardo';

    my $info;
    my $ctl = $self->{bucardo};

    ## Build the connection options
    my $bc = $self->{bcinfo};
    my $connopts = '';
    for my $arg (qw/host port pass/) {
        my $val = 'DB' . (uc $arg) . '_bucardo';
        next unless exists $bc->{$val} and length $bc->{$val};
        $connopts .= " --db$arg=$bc->{$val}";
    }
    $connopts .= " --dbname=$db --log-dest .";
    $connopts .= " --dbuser=$user";
    ## Just hard-code these, no sense in multiple Bucardo base dbs yet:
    $connopts .= " --dbport=58921";
    my $dbhost = getcwd;
    my $dirname = $pgver{A}{dirname};
    $dbhost .= "/$dirname/socket";
    $connopts .= " --dbhost=$dbhost";

    ## Whitespace cleanup
    $args =~ s/^\s+//s;

    ## Allow the caller to look better
    $args =~ s/^bucardo\s+//;

    ## Set a timeout
    alarm 0;
    eval {
        local $SIG{ALRM} = sub { die "Alarum!\n"; };
        alarm $ALARM_BUCARDO;
        debug("Script: $ctl Connection options: $connopts Args: $args", 3);
        $info = decode( locale => qx{$ctl $connopts $args 2>&1} );
        debug("Exit value: $?", 3);
        die $info if $? != 0;
        alarm 0;
    };

    if ($@ =~ /Alarum/ or $info =~ /Alarum/) {
        return __PACKAGE__ . ' timeout hit, giving up';
    }
    if ($@) {
        return "Error running bucardo: " . decode( locale => $@ ) . "\n";
    }

    debug("bucardo said: $info", 3);

    return $info;

} ## end of ctl


sub restart_bucardo {

    ## Start Bucardo, but stop first if it is already running
    ## Arguments: one, two, or three
    ## 1. database handle to the bucardo_control_test db
    ## 2. The notice we wait for, defaults to: bucardo_started
    ## 3. The message to give to the "pass" function, defaults to: Bucardo was started
    ## Returns: nothing

    my ($self,$dbh,$notice,$passmsg) = @_;

    my $line = (caller)[2];

    $notice ||= 'bucardo_started';
    $passmsg ||= "Bucardo was started (caller line $line)";

    $self->stop_bucardo();

    ## Because the stop signal arrives before the PID is removed, sleep a bit
    sleep 2;

    pass("Starting up Bucardo (caller line $line)");
    $dbh->do('LISTEN bucardo');
    $dbh->do('LISTEN bucardo_boot');
    $dbh->do("LISTEN $notice");
    $dbh->do('LISTEN bucardo_nosyncs');
    $dbh->commit();

    my $output = $self->ctl('start --exit-on-nosync --quickstart testing');

    my $bail = 50;
    my $n;
  WAITFORIT: {
        if ($bail--<0) {
            $output =~ s/^/#     /gmx;
            my $time = localtime;
            die "Bucardo did not start, but we waited!\nTime: $time\nStart output:\n\n$output\n";
        }
        while ($n = $dbh->func('pg_notifies')) {
            my ($name, $pid, $payload) = @$n;
            if ($dbh->{pg_server_version} >= 9999990000) {
                next if $name ne 'bucardo';
                $name = $payload;
            }
            last WAITFORIT if $name eq $notice;
        }
        $dbh->commit();
        sleep 0.2;
        redo;
    }
    pass($passmsg);

    ## There is a race condition here for testing
    ## Bucardo starts up, and gives the notice above.
    ## However, after it does so, CTLs and KIDs start up and look for new rows
    ## If the caller of this function makes changes right away and then kicks,
    ## Bucardo may see them on the "startup kick" and thus the caller will
    ## get a "syncdone" message that was not initiated by *their* kick.
    ## One way around this is to make sure your caller immediately does a 
    ## kick 0, which will flush out the startup kick. If it arrives after the 
    ## startup kick, then it simply returns as a sync with no activity

    return 1;

} ## end of restart_bucardo

sub setup_bucardo {

    ## Installs bucardo via "bucardo install" into a database
    ## The database will be emptied out first if it already exists
    ## If it does not exist, it will be created
    ## If the cluster does not exist, it will be created
    ## Arguments:
    ## 1. Name of the cluster
    ## Returns: database handle to the bucardo database

    my $self = shift;
    my $clustername = shift or die;

    Test::More::note('Installing Bucardo');

    $self->create_cluster($clustername);
    my $dbh = $self->connect_database($clustername, 'postgres');
    if (database_exists($dbh,'bucardo')) {
        ## Kick off all other people
        my $pidcol = $dbh->{pg_server_version} >= 90200 ? 'pid' : 'procpid';
        $SQL = qq{SELECT $pidcol FROM pg_stat_activity WHERE datname = 'bucardo' and $pidcol <> pg_backend_pid()};
        for my $row (@{$dbh->selectall_arrayref($SQL)}) {
            my $pid = $row->[0];
            $SQL = 'SELECT pg_terminate_backend(?)';
            $sth = $dbh->prepare($SQL);
            $sth->execute($pid);
        }
        $dbh->commit();
        debug(qq{Dropping database bucardo from cluster $clustername});
        local $dbh->{AutoCommit} = 1;
        $dbh->do('DROP DATABASE bucardo');
    }

    ## Make sure we have a postgres role
    if (! user_exists($dbh, 'postgres')) {
        $dbh->do('CREATE USER postgres SUPERUSER');
        $dbh->commit();
    }

    ## Now run the install. Timeout after a few seconds
    debug(qq{Running bucardo install on cluster $clustername});
    my $info = $self->ctl('install --batch', 'postgres');

    if ($info !~ /Installation is now complete/) {
        die "Installation failed: $info\n";
    }

    ## Reconnect to the new database
    $dbh = $self->connect_database($clustername, 'bucardo');

    ## Make some adjustments
    $sth = $dbh->prepare('UPDATE bucardo.bucardo_config SET setting = $2 WHERE name = $1');
    $count = $sth->execute('piddir' => $PIDDIR);
    $count = $sth->execute('reason_file' => "$PIDDIR/reason");
    $count = $sth->execute('sendmail_file' => 'debug.sendmail.txt');
    $count = $sth->execute('audit_pid' => 1);
    $dbh->commit();

    ## Adjust a second way
    $self->ctl('set log_level=debug log_microsecond=1 log_showline=1');

    debug(qq{Install complete});

    return $dbh;

} ## end of setup_bucardo

## Utility functions for object existences:
sub thing_exists {
    my ($dbh,$name,$table,$column) = @_;
    my $SQL = "SELECT 1 FROM $table WHERE $column = ?";
    ## Only want tables from the public schema for now
    if ($table eq 'pg_class') {
        $SQL .= qq{ AND relnamespace = (SELECT oid FROM pg_namespace WHERE nspname = 'public')};
    }
    my $sth = $dbh->prepare($SQL);
    $count = $sth->execute($name);
    $sth->finish();
    $dbh->commit() if ! $dbh->{AutoCommit};
    return $count < 1 ? 0 : $count;
}
sub schema_exists   { return thing_exists(@_, 'pg_namespace', 'nspname'); }
sub language_exists { return thing_exists(@_, 'pg_language',  'lanname'); }
sub database_exists { return thing_exists(@_, 'pg_database',  'datname'); }
sub user_exists     { return thing_exists(@_, 'pg_user',      'usename'); }
sub table_exists    { return thing_exists(@_, 'pg_class',     'relname'); }
sub function_exists { return thing_exists(@_, 'pg_proc',      'proname'); }
sub domain_exists   { return thing_exists(@_, 'pg_type',      'typname'); }


sub wait_for_notice {

    ## Wait until a named NOTIFY is issued
    ## Arguments:
    ## 1. The listen string or array of strings
    ## 2. Seconds until we give up
    ## 3. Seconds we sleep between checks
    ## 4. Boolean: bail out if not found (defaults to true)
    ## Returns true if the NOTIFY was recieved.

    my $self = shift;
    my $dbh = shift;
    my $text = shift;
    my $timeout = shift || $TIMEOUT_NOTICE;
    my $sleep = shift || $TIMEOUT_SLEEP;
    my $bail = shift;
    $bail = 0 if !defined($bail);
    my $n;
    my %wait_for;
    for my $str (ref $text ? @{ $text } : $text) {
        $wait_for{$str}++;
    }

    eval {
        local $SIG{ALRM} = sub { die "Lookout!\n"; };
        alarm $timeout;
      N: {
            while ($n = $dbh->func('pg_notifies')) {
                my ($name, $pid, $payload) = @$n;
                $name = $payload if length $payload;
                if (exists $wait_for{$name}) {
                    if (--$wait_for{$name} == 0) {
                        delete $wait_for{$name};
                        last N unless %wait_for;
                    }
                }
                else {
                    debug("notice was $name", 1);
                }
            }
            sleep $sleep;
            redo;
        }
        alarm 0;
    };
    if ($@) {
        if ($@ =~ /Lookout/o) {
            my $line = (caller)[2];
            my $now = scalar localtime;
            my $texts = join '", "', keys %wait_for;
            my $pl = keys %wait_for > 1 ? 's' : '';
            my $notice = qq{Gave up waiting for notice$pl "$texts": timed out at $timeout from line $line. Time=$now};
            if ($bail) {
                Test::More::BAIL_OUT ($notice);
            }
            else {
                die $notice;
            }
            return;
        }
    }
    return 1;

} ## end of wait_for_notice

## Older methods:

sub fresh_database {

    ## Drop and create the bucardo_test database
    ## First arg is cluster name
    ## Second arg is hashref, can be 'dropdb'

    my $self = shift;
    my $name = shift || 'A';
    my $arg = shift || {};

    my $dirname = $pgver{$name}{dirname};

    ## Just in case
    -d $dirname or $self->create_cluster($name);
    -e "$dirname/postmaster.pid" or $self->start_cluster($name);

    my $dbh = $self->connect_database($name, 'postgres');

    my $brandnew = 0;
    {
        if (database_exists($dbh => $dbname) and $arg->{dropdb}) {
            local $dbh->{AutoCommit} = 1;
            debug("Dropping database $dbname");
            $dbh->do("DROP DATABASE $dbname");
        }
        if (!database_exists($dbh => $dbname)) {
            local $dbh->{AutoCommit} = 1;
            debug("Creating database $dbname");
            $dbh->do("CREATE DATABASE $dbname");
            $brandnew = 1;
            $dbh->disconnect();
        }
    }

    $dbh = $self->connect_database($name, $dbname);

    return $dbh if $brandnew;

    $self->empty_test_database($dbh);

    return $dbh;

} ## end of fresh_database



sub create_database {

    ## Create a new database
    ## First argument is the cluster name
    ## Second argument is the name of the database
    ## If the database already exists, nothing will be done
    ## Returns a database handle to the database

    my $self = shift;
    my $clustername = shift or die;
    my $dbname = shift or die;

    my $dirname = $pgver{$clustername}{dirname};

    ## Create the cluster if needed
    -d $dirname or $self->create_cluster($clustername);

    ## Start the cluster up if needed
    -e "$dirname/postmaster.pid" or $self->start_cluster($clustername);

    ## Connect to the database

    my $dbh = $self->connect_database($clustername, 'postgres');

    if (! database_exists($dbh => $dbname)) {
        local $dbh->{AutoCommit} = 1;
        debug("Creating database $dbname");
        $dbh->do("CREATE DATABASE $dbname");
        $dbh->disconnect();
    }

    $dbh = $self->connect_database($clustername, $dbname);

    return $dbh;

} ## end of create_database


sub empty_test_database {

    ## Wipe all data tables from a test database
    ## Takes a database handle as only arg

    my $self = shift;
    my $dbh = shift;

    if ($dbh->{pg_server_version} >= 80300) {
        $dbh->do(q{SET session_replication_role = 'replica'});
    }

    for my $table (sort keys %tabletype) {
        $dbh->do(qq{TRUNCATE TABLE "$table"});
    }

    for my $table (@tables2empty) {
        $dbh->do(qq{TRUNCATE TABLE "$table"});
    }

    if ($dbh->{pg_server_version} >= 80300) {
        $dbh->do(q{SET session_replication_role = 'origin'});
    }
    $dbh->commit;

    return;

} ## end of empty_test_database

END {
#    __PACKAGE__->shutdown_cluster($_) for keys %pgver;
}

sub shutdown_cluster {

    ## Shutdown a cluster if running
    ## Takes the cluster name

    my $self = shift;
    my $name = shift;

    my $dirname = $pgver{$name}{dirname};

    return if ! -d $dirname;

    my $pidfile = "$dirname/postmaster.pid";
    return if ! -e $pidfile;

    Test::More::note("Stopping cluster $name");
    my @cmd = ($pg_ctl, '-D', $dirname, '-s', '-m', 'fast', 'stop');
    system(@cmd) == 0 or die "@cmd failed: $?\n";

    ## Hang around until the PID file is gone
    my $loops = 0;
    {
        sleep 0.2;
        last if ! -e $pidfile;
        redo;
    }

    delete $gdbh{$name};

    return;

} ## end of shutdown_cluster


sub remove_cluster {

    ## Remove a cluster, shutting it down first
    ## Takes the cluster name

    my $self = shift;
    my $name = shift;

    my $dirname = $pgver{$name}{dirname};

    return if ! -d $dirname;

    ## Just in case
    $self->shutdown_cluster($name);

    system("rm -fr $dirname");

    return;

} ## end of remove_cluster








sub tt {
    ## Simple timing routine. Call twice with the same arg, before and after
    my $name = shift or die qq{Need a name!\n};
    if (exists $timing{$name}) {
        my $newtime = tv_interval($timing{$name});
        debug("Timing for $name: $newtime");
        delete $timing{$name};
    }
    else {
        $timing{$name} = [gettimeofday];
    }
    return;
} ## end of tt

sub t {

    $testmsg = shift || '';
    $testline = shift || (caller)[2];
    $testmsg =~ s/^\s+//;
    if ($location) {
        $testmsg = "($location) $testmsg";
    }
    $testmsg .= " [line: $testline]";
    my $time = time;
    $testmsg .= " [time: $time]" unless $notime;

    return;

} ## end of t


sub add_test_tables_to_herd {

    ## Add all of the test tables (and sequences) to a herd
    ## Create the herd if it does not exist
    ## First arg is database name, second arg is the herdname

    my $self = shift;
    my $db = shift;
    my $herd = shift;

    my $result = $self->ctl("add herd $herd");
    if ($result !~ /Added herd/) {
        die "Failed to add herd $herd: $result\n";
    }

    my $addstring = join ' ' => sort keys %tabletype;
    my $com = "add table $addstring db=$db herd=$herd";
    $result = $self->ctl($com);
    if ($result !~ /Added table/) {
        die "Failed to add tables: $result (command was: $com)\n";
    }

    $addstring = join ' ' => sort keys %sequences;
    $com = "add sequence $addstring db=$db herd=$herd";
    $result = $self->ctl($com);
    if ($result !~ /Added sequence/) {
        die "Failed to add sequences: $result (command was: $com)\n";
    }

    return;

} ## end of add_test_tables_to_herd


sub bc_deeply {

    my ($exp,$dbh,$sql,$msg,$oline) = @_;
    my $line = (caller)[2];

    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 0;

    die "Very invalid statement from line $line: $sql\n" if $sql !~ /^\s*select/i;

    my $got;
    eval {
        $got = $dbh->selectall_arrayref($sql);
    };
    if ($@) {
        die "bc_deeply failed from line $line. SQL=$sql\n$@\n";
    }

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    return is_deeply($got,$exp,$msg,$oline||(caller)[2]);

} ## end of bc_deeply

sub clear_notices {
    my $dbh = shift;
    my $timeout = shift || $TIMEOUT_NOTICE;
    sleep $timeout;
    0 while (my $n = $dbh->func('pg_notifies'));
}


sub get_pgctl_options {
    my $dirname = shift;
    my $option;
    if ($^O !~ /Win32/) {
        my $sockdir = "$dirname/socket";
        -e $sockdir or mkdir $sockdir;
        $option = q{-o '-k socket'};
    }
    return $option;
}

sub remove_single_dir {

    my $dirname = shift;
    print "Removing test database in $dirname\n";
    # Try stopping PostgreSQL
    my $options = get_pgctl_options($dirname);
    qx{$pg_ctl $options -l $dirname/pg.log -D $dirname stop -m immediate};
    sleep 2;
    qx{rm -rf $dirname};
    return;

}

sub drop_database {

    my ($self, $dir) = @_;
    if ($dir eq 'all') {
        ok(opendir(my $dh, '.'), 'Open current directory to clean up');
        my @test_db_dirs = grep { -d $_ && /^bucardo_test_database/ } readdir $dh;
        close($dh);

        for my $dirname (@test_db_dirs) {
            remove_single_dir($dirname);
        }
    }
    else {
        remove_single_dir($dir);
    }
    return;
}


sub add_row_to_database {

    ## Add a row to each table in one of the databases
    ## Arguments: three
    ## 1. Database name to use
    ## 2. Value to use (lookup, not the direct value)
    ## 3. Do we commit or not? Boolean, defaults to true
    ## Returns: undef

    my ($self, $dbname, $xval, $commit) = @_;


    if ($xval > $xvalmax) {
        die "Too high of an ID: max is $xvalmax\n";
    }

    $commit = 1 if ! defined $commit;

    my $dbh = $gdbh{$dbname} or die "No such database: $dbname";

    ## Loop through each table we know about
    for my $table (sort keys %tabletype) {

        ## Look up the actual value to use
        my $type = $tabletype{$table};
        my $value = $val{$type}{$xval};

        ## Prepare it if we have not already
        if (! exists $gsth{$dbh}{insert}{$xval}{$table}) {

            ## Handle odd pkeys
            my $pkey = $table =~ /test5/ ? q{"id space"} : 'id';

            ## Put some standard values in, plus a single placeholder
            my $SQL = qq{INSERT INTO "$table"($pkey,data1,inty,booly) VALUES (?,'foo',$xval,'true')};
            $gsth{$dbh}{insert}{$xval}{$table} = $dbh->prepare($SQL);

            ## If this is a bytea, we need to tell DBD::Pg about it
            if ('BYTEA' eq $type) {
                $gsth{$dbh}{insert}{$xval}{$table}->bind_param(1, undef, {pg_type => PG_BYTEA});
            }

        }

        ## Execute!
        $gsth{$dbh}{insert}{$xval}{$table}->execute($value);

    }

    $dbh->commit() if $commit;

    return undef;

} ## end of add_row_to_database


sub update_row_in_database {

    ## Change a row in each table in a database
    ## We always change the "inty" field
    ## Arguments: four
    ## 1. Database name to use
    ## 2. Primary key to update
    ## 3. New value
    ## 4. Do we commit or not? Boolean, defaults to true
    ## Returns: undef

    my ($self, $dbname, $pkeyvalue, $newvalue, $commit) = @_;

    $commit = 1 if ! defined $commit;

    my $dbh = $gdbh{$dbname} or die "No such database: $dbname";

    ## Loop through each table we know about
    for my $table (sort keys %tabletype) {

        ## Look up the actual value to use
        my $type = $tabletype{$table};
        my $value = $val{$type}{$pkeyvalue};

        ## Prepare it if we have not already
        if (! exists $gsth{$dbh}{update}{inty}{$table}) {

            ## Handle odd pkeys
            my $pkey = $table =~ /test5/ ? q{"id space"} : 'id';

            my $SQL = qq{UPDATE "$table" SET inty=? WHERE $pkey = ?};
            $gsth{$dbh}{update}{inty}{$table} = $dbh->prepare($SQL);

            if ('BYTEA' eq $type) {
                $gsth{$dbh}{update}{inty}{$table}->bind_param(2, undef, {pg_type => PG_BYTEA});
            }

        }

        ## Execute!
        $gsth{$dbh}{update}{inty}{$table}->execute($newvalue,$value);

    }

    $dbh->commit() if $commit;

    return undef;

} ## end of update_row_in_database


sub remove_row_from_database {

    ## Delete a row from each table in one of the databases
    ## Arguments: three
    ## 1. Database name to use
    ## 2. Value to use (lookup, not the direct value). Can be an arrayref.
    ## 3. Do we commit or not? Boolean, defaults to true
    ## Returns: undef

    my ($self, $dbname, $val, $commit) = @_;

    $commit = 1 if ! defined $commit;

    my $dbh = $gdbh{$dbname} or die "No such database: $dbname";

    ## Loop through each table we know about
    for my $table (sort keys %tabletype) {

        ## Prepare it if we have not already
        if (! exists $gsth{$dbh}{delete}{$table}) {

            ## Delete, based on the inty
            my $SQL = qq{DELETE FROM "$table" WHERE inty = ?};
            $gsth{$dbh}{delete}{$table} = $dbh->prepare($SQL);

        }

        ## Execute it.
        if (ref $val) {
            for (@$val) {
                $gsth{$dbh}{delete}{$table}->execute($_);
            }
        }
        else {
            $gsth{$dbh}{delete}{$table}->execute($val);
        }

    }

    $dbh->commit() if $commit;

    return undef;

} ## end of remove_row_from_database


sub truncate_all_tables {

    ## Truncate all the tables
    ## Arguments: two
    ## 1. Database to use
    ## 3. Do we commit or not? Boolean, defaults to true
    ## Returns: undef

    my ($self, $dbname, $commit) = @_;

    $commit = 1 if ! defined $commit;

    my $dbh = $gdbh{$dbname} or die "No such database: $dbname";

    ## Loop through each table we know about
    for my $table (sort keys %tabletype) {
        $dbh->do(qq{TRUNCATE Table "$table"});
    }

    $dbh->commit() if $commit;

    return undef;

} ## end of truncate_all_tables


sub delete_all_tables {

    ## Delete all the tables.
    ## Mostly for old versions that do not support truncate triggers.
    ## Arguments: two
    ## 1. Database to use
    ## 3. Do we commit or not? Boolean, defaults to true
    ## Returns: undef

    my ($self, $dbname, $commit) = @_;

    $commit = 1 if ! defined $commit;

    my $dbh = $gdbh{$dbname} or die "No such database: $dbname";

    ## Loop through each table we know about
    for my $table (sort keys %tabletype) {
        $dbh->do(qq{DELETE FROM "$table"});
    }

    $dbh->commit() if $commit;

    return undef;

} ## end of delete_all_tables


sub check_for_row {

    ## Check that a given row is on the database as expected: checks the inty column only
    ## Arguments: two or three or four
    ## 1. The result we are expecting, as an arrayref
    ## 2. A list of database names (should be inside gdbh)
    ## 3. Optional text to append to output message
    ## 4. Optional tables to limit checking to
    ## Returns: undef

    my ($self, $res, $dblist, $text, $filter) = @_;

    ## Get largest tablename
    my $maxtable = 1;
    for my $table (keys %tabletype) {
        ## Allow skipping tables
        if (defined $filter) {
            my $f = $filter;
            if ($f =~ s/^\!//) {
                if ($table =~ /$f$/) {
                    delete $tabletype{$table};
                    next;
                }
            }
            else {
                if ($table !~ /$f$/) {
                    delete $tabletype{$table};
                    next;
                }
            }
        }
        $maxtable = length $table if length $table > $maxtable;
    }

    for my $dbname (@$dblist) {

        if (! $gdbh{$dbname}) {
            $gdbh{$dbname} = $self->connect_database($dbname,$BucardoTesting::dbname);
        }

        my $dbh = $gdbh{$dbname};

        my $maxdbtable = $maxtable + 1 + length $dbname;

        for my $table (sort keys %tabletype) {

            ## Handle odd pkeys
            my $pkey = $table =~ /test5/ ? q{"id space"} : 'id';

            my $type = $tabletype{$table};
            my $t = sprintf qq{%-*s copy ok (%s)},
                $maxdbtable,
                "$dbname.$table",
                    $type;

            ## Change the message if no rows
            if (ref $res eq 'ARRAY' and ! defined $res->[0]) {
                $t = sprintf qq{No rows as expected in %-*s for pkey type %s},
                    $maxdbtable,
                    "$dbname.$table",
                    $type;
            }

            if (defined $text and length $text) {
                $t .= " $text";
            }

            my $SQL = qq{SELECT inty FROM "$table" ORDER BY inty};
            $table =~ /X/ and $SQL =~ s/inty/$pkey/;

            local $Test::Builder::Level = $Test::Builder::Level + 1;
            my $result = bc_deeply($res, $dbh, $SQL, $t, (caller)[2]);
            $dbh->commit();
            if (!$result) {
                my $line = (caller)[2];
                Test::More::BAIL_OUT "Stopping on a failed 'check_for_row' test from line $line";
            }
        }
    }

    return;

} ## end of check_for_row


sub check_sequences_same {

    ## Check that sequences are the same across all databases
    ## Arguments: one
    ## 1. A list of database names (should be inside gdbh)
    ## Returns: undef

    my ($self, $dblist) = @_;

    for my $seq (sort keys %sequences) {

        $SQL = qq{SELECT * FROM "$seq"};

        ## The first we come across will be the standard for the others
        my (%firstone, $firstdb);

        ## Store failure messages
        my @msg;

        for my $dbname (@$dblist) {

            my $dbh = $gdbh{$dbname} or die "Invalid database name: $dbname";

            my $sth = $dbh->prepare($SQL);
            $sth->execute();
            my $info = $sth->fetchall_arrayref({})->[0];

            if (! defined $firstone{$seq}) {
                $firstone{$seq} = $info;
                $firstdb = $dbname;
                next;
            }

            ## Compare certain items
            for my $item (qw/ last_value start_value increment_by min_value max_value is_cycled is_called/) {
                my ($uno,$dos) = ($firstone{$seq}->{$item}, $info->{$item});
                next if ! defined $uno or ! defined $dos;
                if ($uno ne $dos) {
                    push @msg, "$item is different on $firstdb vs $dbname: $uno vs $dos";
                }
            }

        } ## end each sequence

        if (@msg) {
            Test::More::fail("Sequence $seq NOT the same");
            for (@msg) {
                diag($_);
            }
        }
        else {
            Test::More::pass("Sequence $seq is the same across all databases");
        }

    } ## end each database


    return;


} ## end of check_sequences_same




## Hack to override some Test::More methods
## no critic

sub is_deeply {

    t($_[2],$_[3] || (caller)[2]);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $rv = Test::More::is_deeply($_[0],$_[1],$testmsg);
    return $rv if $rv;
    if ($bail_on_error and ++$total_errors => $bail_on_error) {
        my $line = (caller)[2];
        my $time = time;
        diag("GOT: ".Dumper $_[0]);
        diag("EXPECTED: ".Dumper $_[1]);
        Test::More::BAIL_OUT "Stopping on a failed 'is_deeply' test from line $line. Time: $time";
    }
} ## end of is_deeply
sub like($$;$) {
    t($_[2],(caller)[2]);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $rv = Test::More::like($_[0],$_[1],$testmsg);
    return $rv if $rv;
    if ($bail_on_error and ++$total_errors => $bail_on_error) {
        my $line = (caller)[2];
        my $time = time;
#        Test::More::diag("GOT: ".Dumper $_[0]);
#        Test::More::diag("EXPECTED: ".Dumper $_[1]);
        Test::More::BAIL_OUT "Stopping on a failed 'like' test from line $line. Time: $time";
    }
} ## end of like
sub pass(;$) {
    t($_[0],$_[1]||(caller)[2]);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    Test::More::pass($testmsg);
} ## end of pass
sub is($$;$) {
    t($_[2],(caller)[2]);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $rv = Test::More::is($_[0],$_[1],$testmsg);
    return $rv if $rv;
    ## Where exactly did this fail?
    my $char = 0;
    my $onelen = length $_[0];
    my $twolen = length $_[1];
    my $line = 1;
    my $lchar = 1;
    for ($char = 0; $char < $onelen and $char < $twolen; $char++) {
        my $one = ord(substr($_[0],$char,1));
        my $two = ord(substr($_[1],$char,1));
        if ($one != $two) {
            diag("First difference at character $char ($one vs $two) (line $line, char $lchar)");
            last;
        }
        if (10 == $one) {
            $line++;
            $lchar = 1;
        }
        else {
            $lchar++;
        }
    }
    if ($bail_on_error and ++$total_errors => $bail_on_error) {
        my $line = (caller)[2];
        my $time = time;
        Test::More::BAIL_OUT "Stopping on a failed 'is' test from line $line. Time: $time";
    }
} ## end of is
sub isa_ok($$;$) {
    t("Object isa $_[1]",(caller)[2]);
    my ($name, $type, $msg) = ($_[0],$_[1]);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if (ref $name and ref $name eq $type) {
        Test::More::pass($testmsg);
        return;
    }
    if ($bail_on_error and ++$total_errors => $bail_on_error) {
        Test::More::BAIL_OUT "Stopping on a failed test";
    }
} ## end of isa_ok
sub ok($;$) {
    t($_[1]||$testmsg);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $rv = Test::More::ok($_[0],$testmsg);
    return $rv if $rv;
    if ($bail_on_error and ++$total_errors => $bail_on_error) {
        my $line = (caller)[2];
        my $time = time;
        Test::More::BAIL_OUT "Stopping on a failed 'ok' test from line $line. Time: $time";
    }
} ## end of ok

## use critic


1;
