CPAN::Groonga

# $Id: db-common.pl 91 2006-08-17 00:39:55Z bradfitz $

use strict;
use File::Spec;
use Carp qw(croak);
use DBI;
use FindBin;
use JSON::Any;

use lib "$ENV{HOME}/hack/Data-ObjectDriver/lib";
use lib "$ENV{HOME}/hack/TheSchwartz/lib";
use lib "$ENV{HOME}/hack/gearman/api/perl/Gearman/lib";
use lib "$ENV{HOME}/cvs/Data-ObjectDriver/lib";
use lib "$ENV{HOME}/cvs/TheSchwartz/lib";
use lib "$ENV{HOME}/cvs/gearman/api/perl/Gearman/lib";

sub json {
    return JSON::Any->objToJson(shift);
}

sub unjson {
    return JSON::Any->json_to_obj(shift);
}

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 );
    }

    return TheSchwartz->new(
        databases => [
            map {
                {   dsn    => dsn_for($_),
                    user   => "root",
                    pass   => "",
                    prefix => $pfx,
                }
                } @$dbs
        ]
    );
}

package TestDB;
use strict;

sub new {
    my $class = shift;
    my $name  = shift || "unnamed";
    my $db    = TestDB::MySQL->new($name) || TestDB::SQLite->new($name);
    if ($db) {
        my $dbh    = $db->dbh;
        my $schema = $db->schema_file;
        my @sql    = _load_sql($schema);
        for my $sql (@sql) {
            $db->alter_create( \$sql );
            $dbh->do($sql);
        }
        $dbh->disconnect;
        return $db;
    }

    eval {
        Test::More::plan(
            skip_all => "MySQL or SQLite not available for testing" );
    };
    if ($@) {
        return undef;
    }
    exit(0);
}

sub dbh {
    my ($self) = @_;
    return DBI->connect( $self->dsn, "root", "", { RaiseError => 1 } );
}

sub alter_create {
    my $sqlref = shift;

    # subclasses can override
}

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;
}

package TestDB::MySQL;
use strict;
use base 'TestDB';

sub new {
    my ( $class, $name ) = @_;

    my $dbh = eval { _mysql_dbh() } or return undef;
    my $self = bless {
        basename => $name,
        dbname   => "t_sch_$name",
        root_dbh => $dbh,
    }, $class;

    $dbh->do("DROP DATABASE IF EXISTS $self->{dbname}");
    $dbh->do("CREATE DATABASE $self->{dbname}");
    return $self;
}

sub dsn {
    my ($self) = @_;
    return "DBI:mysql:" . $self->{dbname};
}

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

sub alter_create {
    my ( $self, $sqlref ) = @_;
    $$sqlref .= " ENGINE=INNODB\n";
}

sub schema_file {
    return "../doc/schema.sql";
}

package TestDB::SQLite;
use strict;
use base 'TestDB';

sub new {
    return undef;
}

package TestServer;
use strict;

sub new {
    my ( $class, $db ) = @_;
    $db ||= TestDB->new || return undef;
    my $pid = fork;
    die "out of memory" unless defined $pid;
    if ($pid) {
        return bless { pid => $pid, }, $class;
    }

    my $bin = "$FindBin::Bin/../bin/schwartzd";
    die "Not exist: $bin"      unless -e $bin;
    die "Not executable: $bin" unless -x $bin;
    exec $bin;
    die "Failed to exec test schwartzd!";
}

sub gearman_client {
    my $self = shift;
    my $cl   = Gearman::Client->new;
    $cl->job_servers('127.0.0.1:7003');
    return $cl;
}

sub DESTROY {
    my $self = shift;
    if ( $self->{pid} ) {
        kill 9, $self->{pid};
    }
}

1;