The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package t::Util;

use strict;
use warnings;
use DBI;
use File::Temp qw/tempfile/;
use base 'Exporter';
use Benchmark qw/:hireswallclock/;
use IO::Handle;

our @EXPORT = qw/capture capture_logger cmpthese/;

BEGIN {
    # cleanup environment
    for my $key (keys %ENV) {
        next unless $key =~ /^DBIX_QUERYLOG_/;
        delete $ENV{$key};
    }
}

sub new_dbh {
    my ($fh, $file) = tempfile;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$file",'','', {
        AutoCommit => 1,
        RaiseError => 1,
    });
    return $dbh;
}

sub new_logger {
    bless {}, 't::Util::Logger';
}

sub setup_mysqld {
    eval { require Test::mysqld; 1 } or return;
    my $mysqld;
    my $json = $ENV{__TEST_DBIxQueryLog};
    my $obj;
    if ($json) {
        eval { require JSON; 1 } or return;
        $obj = JSON::decode_json($json);
    }

    if ($obj && $obj->{mysql}) {
        $mysqld = bless $obj->{mysql}, 'Test::mysqld';
    }
    else {
        $mysqld = Test::mysqld->new(my_cnf => {
            'skip-networking' => '',
        }) or return;
    }

    return $mysqld;
}

sub setup_postgresql {
    eval { require Test::PostgreSQL; Test::PostgreSQL->VERSION >= 0.1 } or return;
    my $pg;
    my $json = $ENV{__TEST_DBIxQueryLog};
    my $obj;
    if ($json) {
        eval { require JSON; 1 } or return;
        $obj = JSON::decode_json($json);
    }

    if ($obj && $obj->{pg}) {
        use Data::Dumper; print Dumper($obj);
        $pg = bless $obj->{pg}, 'Test::PostgreSQL';
    }
    else {
        $pg = Test::PostgreSQL->new() or return;
        my $dbh = DBI->connect(
            $pg->dsn(dbname => 'test'), '', '',
            {
                AutoCommit => 1,
                RaiseError => 1,
            },
        ) or die $DBI::errstr;
        # mysql tests use the "user" table name and Pg's "user" is a function.
        # so we don't use table name "user" without quotaion marks in pg tests.
        # but mendo-kusai node sonnomama ni sita.
        $dbh->do('CREATE TABLE "user" ("User" text)');
        $dbh->disconnect;
    }

    return $pg;
}

sub capture(&) {
    my ($code) = @_;

    open my $fh, '>', \my $content;
    $fh->autoflush(1);
    local $DBIx::QueryLog::OUTPUT = $fh;
    $code->();
    close $fh;
    return $content;
}

sub capture_logger(&) {
    my ($code) = @_;

    my $content;

    my $logger = DBIx::QueryLog->logger;
    no strict 'refs';
    no warnings 'redefine';
    my $logger_class = ref $logger;
    *{"$logger_class\::log"} = sub {
        my ($class, %p) = @_;
        $content = $p{params};
    };

    $code->();

    return $content;
}

sub cmpthese {
    my $result = Benchmark::timethese(@_);
    for my $value (values %$result) {
        $value->[1] = $value->[2] = $value->[0];
    };
    Benchmark::cmpthese($result);
}

package t::Util::Logger;

sub log {
    die 'fix me';
}

1;