The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package t::Utils;
use strict;
use warnings;
use base qw/Exporter/;
use blib;
use Test::More;
use DBI;
our @EXPORT = (@Test::More::EXPORT, 'run_test');

eval 'require File::Temp';
plan skip_all => 'this test requires File::Temp' if $@;
if ($ENV{TSM_TEST_PG}) {
    plan skip_all => 'DBD::Pg support not working on windows yet'
        if $^O =~ /windows/i;
    eval 'require DBD::Pg';
    plan skip_all => 'this test requires DBD::Pg' if $@;
}
else {
    eval 'require DBD::SQLite';
    plan skip_all => 'this test requires DBD::SQLite' if $@;
}

our $dbcount = 0;

sub run_test (&) {
    my $code = shift;
    local $dbcount = $dbcount+1;
    local $@;

    my $tmp = File::Temp->new;
    $tmp->close();
    my $dbname;
    my $dbh;

    if ($ENV{TSM_TEST_PG}) {
        my $createdb = $ENV{PGCREATEDB} || 'createdb';
        $dbname = $ENV{PGDBPREFIX} || 'schwartz';
        $dbname .= $dbcount;

        my $diag = File::Temp->new(UNLINK => 1);
        my $rv = do {
            local %ENV = %ENV;
            delete $ENV{$_} for grep /^LC_/, keys %ENV;
            $ENV{LANG} = 'C';
            system("$createdb -E UTF-8 -l en_US.UTF-8 $dbname > $diag 2>&1");
        };
        if ($rv) {
            $diag->seek(0,0);
            my $txt = do {local $/; <$diag>};
            diag "createdb failed: $txt";
            diag "HINT: you can set the PGUSER env-var to control who to connect as";
            diag "HINT: you can set the PGCREATEDB/PGDROPDB env-vars to pick createdb/dropdb invocations to use";

            if ($txt =~ /authentication failed for user/) {
                diag "HINT: you may need to createuser or adjust pg_hba.conf";
            }
            elsif ($txt =~ /permission denied to create database/) {
                diag "HINT: user needs create database permissions (the -d flag for createuser)";
            }
            elsif ($txt =~ /database "\Q$dbname\E" already exists/) {
                diag "HINT: you may need to drop '$dbname' manually";
            }

            die "SETUP: can't set up postgres database '$dbname'";
        }

        $dbh = DBI->connect("dbi:Pg:database=$dbname", '', '', {
            AutoCommit => 1,
            RaiseError => 1,
            PrintError => 0,
        }) or die "SETUP: $DBI::errstr";
    }
    else {
        $dbname = $tmp->filename;
        $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", '', '', {
            RaiseError => 1,
            PrintError => 0,
        }) or die $DBI::errstr;

        # work around for DBD::SQLite's resource leak
        tie my %blackhole, 't::Utils::Blackhole';
        $dbh->{CachedKids} = \%blackhole;
    }

    init_schwartz($dbh);

    eval {
        $code->($dbh); # do test
    };
    my $e = $@ if $@;

    eval {
        $dbh->disconnect;

        if ($ENV{TSM_TEST_PG}) {
            my $dropdb = $ENV{PGDROPDB} || 'dropdb';
            system("$dropdb -e $dbname") and die "can't dropdb $dbname";
        }
    };
    if ($@) {
        diag "while disconnecting/dropping: $@";
    }

    if ($e) {
        $@ = $e;
        die $@;
    }
}

sub init_schwartz {
    my $dbh = shift;
    my $name = $dbh->{Driver}{Name};

    my $schemafile = "schema/$name.sql";
    my $schema = do { local(@ARGV,$/)=$schemafile; <> };
    die "Schmema not found" unless $schema;
    my $prefix = $::prefix || "";
    $schema =~ s/PREFIX_/$prefix/g;

    do {
        $dbh->begin_work;
        for (split /;\s*/m, $schema) {
            $dbh->do($_);
        }
        $dbh->commit;
    };
}

{
    package t::Utils::Blackhole;
    use base qw/Tie::Hash/;
    sub TIEHASH { bless {}, shift }
    sub STORE { } # nop
    sub FETCH { } # nop
}

1;