The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Id$

use strict;
use File::Spec;
use Carp qw(croak);

sub run_tests {
    my ( $n, $code ) = @_;

    run_tests_mysql( $n, $code );
    run_tests_pgsql( $n, $code );
    run_tests_sqlite( $n, $code );
}

sub run_tests_innodb {
    my ( $n, $code ) = @_;
    run_tests_mysql( $n, $code, 1 );
}

sub run_tests_mysql {
    my ( $n, $code, $innodb ) = @_;
SKIP: {
        local $ENV{USE_MYSQL} = 1;
        local $ENV{TS_DB_USER} ||= 'root';
        my $dbh = eval { mysql_dbh() };
        skip "MySQL not accessible as root on localhost", $n if $@;
        skip "InnoDB not available on localhost's MySQL", $n
            if $innodb && !has_innodb($dbh);
        $code->();
    }
}

sub run_tests_pgsql {
    my ( $n, $code ) = @_;
SKIP: {
        local $ENV{USE_PGSQL} = 1;
        local $ENV{TS_DB_USER} ||= 'postgres';
        my $dbh = eval { pgsql_dbh() };
        skip "PgSQL not accessible as root on localhost", $n if $@;
        $code->();
    }
}

sub run_tests_sqlite {
    my ( $n, $code ) = @_;

    # SQLite
SKIP: {
        my $rv = eval "use DBD::SQLite; 1";
        $rv = 0 if $ENV{SKIP_SQLITE};
        skip "SQLite not installed", $n if !$rv;
        $code->();
    }
}

sub test_client {
    my %opts = @_;
    my $dbs  = delete $opts{dbs};
    my $init = delete $opts{init};
    my $pfx  = delete $opts{dbprefix};
    croak "'dbs' not an ARRAY" unless ref $dbs eq "ARRAY";
    croak "unknown opts" if %opts;
    $init = 1 unless defined $init;

    if ($init) {
        setup_dbs( { prefix => $pfx }, $dbs );
    }

    if ( $ENV{USE_DBH_FOR_TEST} || $ENV{USE_GET_DBH_FOR_TEST} ) {
        my @tmp;
        for (@$dbs) {
            eval {
                my $dsn = dsn_for($_);
                my $dbh = DBI->connect(
                    $dsn, "root", "",
                    {   RaiseError => 1,
                        PrintError => 0,
                        AutoCommit => 1,
                    }
                ) or die $DBI::errstr;
                my $driver = Data::ObjectDriver::Driver::DBI->new(
                    $ENV{USE_GET_DBH_FOR_TEST}
                    ? ( get_dbh => sub {$dbh} )
                    : ( dbh => $dbh )
                );
                push @tmp, { driver => $driver, prefix => $pfx };
            };
        }
        return TheSchwartz->new( databases => [@tmp] );
    }
    else {
        return TheSchwartz->new(
            databases => [
                map {
                    {   dsn    => dsn_for($_),
                        user   => $ENV{TS_DB_USER},
                        pass   => $ENV{TS_DB_PASS},
                        prefix => $pfx,
                    }
                } @$dbs
            ]
        );
    }
}

sub has_innodb {
    my $dbh     = shift;
    my $tmpname = "test_to_see_if_innoavail";
    $dbh->do("CREATE TABLE IF NOT EXISTS $tmpname (i int) ENGINE=INNODB")
        or return 0;
    my @row    = $dbh->selectrow_array("SHOW CREATE TABLE $tmpname");
    my $row    = join( ' ', @row );
    my $has_it = ( $row =~ /=InnoDB/i );
    $dbh->do("DROP TABLE $tmpname");
    return $has_it;
}

sub schema_file {
    return "doc/schema.sql"          if $ENV{USE_MYSQL};
    return "doc/schema-postgres.sql" if $ENV{USE_PGSQL};
    return "t/schema-sqlite.sql";
}

sub db_filename {
    my ($dbname) = @_;
    return $dbname . '.db';
}

sub mysql_dbname {
    my ($dbname) = @_;
    return 't_sch_' . $dbname;
}

sub dsn_for {
    my $dbname = shift;
    if ( $ENV{USE_MYSQL} ) {
        return 'dbi:mysql:' . mysql_dbname($dbname);
    }
    elsif ( $ENV{USE_PGSQL} ) {
        return 'dbi:Pg:dbname=' . mysql_dbname($dbname);
    }
    else {
        return 'dbi:SQLite:dbname=' . db_filename($dbname);
    }
}

sub setup_dbs {
    shift if $_[0] =~ /\.sql$/;    # skip filenames (old)

    my $opts = ref $_[0] eq "HASH" ? shift : {};
    my $pfx = delete $opts->{prefix} || "";
    die "unknown opts" if %$opts;

    my (@dbs) = @_;
    my $dbs = ref $dbs[0] ? $dbs[0] : \@dbs; # support array or arrayref (old)

    my $schema = schema_file();
    teardown_dbs(@$dbs);
    for my $dbname (@$dbs) {
        if ( $ENV{USE_MYSQL} ) {
            create_mysql_db( mysql_dbname($dbname) );
        }
        elsif ( $ENV{USE_PGSQL} ) {
            create_pgsql_db( mysql_dbname($dbname) );
        }
        my $dbh
            = DBI->connect( dsn_for($dbname), $ENV{TS_DB_USER},
            $ENV{TS_DB_PASS}, { RaiseError => 1, PrintError => 0 } )
            or die "Couldn't connect: $!\n";
        my @sql = load_sql($schema);
        for my $sql (@sql) {
            $sql =~ s!^\s*create\s+table\s+(\w+)!CREATE TABLE ${pfx}$1!mi;
            $sql
                =~ s!^\s*(create.*?index)\s+(\w+)\s+on\s+(\w+)!$1 $2 ON ${pfx}$3!i;
            $sql .= " ENGINE=INNODB\n" if $ENV{USE_MYSQL};
            $dbh->do($sql);
        }
        $dbh->disconnect;
    }
}

sub mysql_dbh {
    return DBI->connect( "DBI:mysql:mysql", "root", "", { RaiseError => 1 } )
        || die "Couldn't connect to database";
}

my $pg_dbh;

sub pgsql_dbh {
    return $pg_dbh if $pg_dbh;
    $pg_dbh
        ||= DBI->connect( "DBI:Pg:dbname=postgres", "postgres", "",
        { RaiseError => 1 } )
        or die "Couldn't connect to database";
}

sub create_mysql_db {
    my $dbname = shift;
    mysql_dbh()->do("CREATE DATABASE $dbname");
}

sub drop_mysql_db {
    my $dbname = shift;
    mysql_dbh()->do("DROP DATABASE IF EXISTS $dbname");
}

sub create_pgsql_db {
    my $dbname = shift;
    pgsql_dbh()->do("CREATE DATABASE $dbname");
}

sub drop_pgsql_db {
    my $dbname = shift;
    undef $pg_dbh;
    eval { pgsql_dbh()->do("DROP DATABASE IF EXISTS $dbname") };
}

sub teardown_dbs {
    my (@dbs) = @_;
    for my $db (@dbs) {
        if ( $ENV{USE_MYSQL} ) {
            drop_mysql_db( mysql_dbname($db) );
        }
        elsif ( $ENV{USE_PGSQL} ) {
            drop_pgsql_db( mysql_dbname($db) );
        }
        else {
            my $file = db_filename($db);
            next unless -e $file;
            unlink $file or die "Can't teardown $db: $!";
        }
    }
}

sub load_sql {
    my ($file) = @_;
    open my $fh, $file or die "Can't open $file: $!";
    my $sql = do { local $/; <$fh> };
    close $fh;
    split /;\s*/, $sql;
}

sub query_sql {
    my ( $dbh, $sql ) = @_;
    my ( $query, $bind ) = ref($sql) ? @$sql : ( $sql, [] );
    my $sth = $dbh->prepare($sql);
    my $i   = 0;
    $sth->bind_param( ++$i, $_ ) for @$bind;
    $sth->execute;
    $sth->bind_columns( \my $result );
    $sth->fetch;
    return $result;
}

1;