Fixed up so that SQLite is supported

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Storage / DBI.pm

package DBM::Deep::Storage::DBI;

use 5.006_000;

use strict;
use warnings FATAL => 'all';

use base 'DBM::Deep::Storage';

use DBI;

sub new {
    my $class = shift;
    my ($args) = @_;

    my $self = bless {
        autobless => 1,
        dbh       => undef,
        dbi       => undef,
    }, $class;

    # Grab the parameters we want to use
    foreach my $param ( keys %$self ) {
        next unless exists $args->{$param};
        $self->{$param} = $args->{$param};
    }

    if ( $self->{dbh} ) {
        $self->{driver} = lc $self->{dbh}->{Driver}->{Name};
    }
    else {
        $self->open;
    }

    # Foreign keys are turned off by default in SQLite3 (for now)
    #q.v.  http://search.cpan.org/~adamk/DBD-SQLite-1.27/lib/DBD/SQLite.pm#Foreign_Keys
    # for more info.
    if ( $self->driver eq 'sqlite' ) {
        $self->{dbh}->do( 'PRAGMA foreign_keys = ON' );
    }

    return $self;
}

sub open {
    my $self = shift;

    return if $self->{dbh};

    $self->{dbh} = DBI->connect(
        $self->{dbi}{dsn}, $self->{dbi}{username}, $self->{dbi}{password}, {
            AutoCommit => 0,
            PrintError => 0,
            RaiseError => 1,
            %{ $self->{dbi}{connect_args} || {} },
        },
    ) or die $DBI::error;

    # Should we use the same method as done in new() if passed a $dbh?
    (undef, $self->{driver}) = map lc, DBI->parse_dsn( $self->{dbi}{dsn} );

    return 1;
}

sub close {
    my $self = shift;
    $self->{dbh}->disconnect if $self->{dbh};
    return 1;
}

sub DESTROY {
    my $self = shift;
    $self->close if ref $self;
}

# Is there a portable way of determining writability to a DBH?
sub is_writable {
    my $self = shift;
    return 1;
}

sub lock_exclusive {
    my $self = shift;
}

sub lock_shared {
    my $self = shift;
}

sub unlock {
    my $self = shift;
    $self->{dbh}->commit;
}

sub read_from {
    my $self = shift;
    my ($table, $cond, @cols) = @_;

    $cond = { id => $cond } unless ref $cond;

    my @keys = keys %$cond;
    my $where = join ' AND ', map { "`$_` = ?" } @keys;

    return $self->{dbh}->selectall_arrayref(
        "SELECT `@{[join '`,`', @cols ]}` FROM $table WHERE $where",
        { Slice => {} }, @{$cond}{@keys},
    );
}

sub flush {}

sub write_to {
    my $self = shift;
    my ($table, $id, %args) = @_;

    my @keys = keys %args;
    my $sql =
        "REPLACE INTO $table ( `id`, "
          . join( ',', map { "`$_`" } @keys )
      . ") VALUES ("
          . join( ',', ('?') x (@keys + 1) )
      . ")";
    $self->{dbh}->do( $sql, undef, $id, @args{@keys} );

    return $self->{dbh}->last_insert_id("", "", "", "");
}

sub delete_from {
    my $self = shift;
    my ($table, $cond) = @_;

    $cond = { id => $cond } unless ref $cond;

    my @keys = keys %$cond;
    my $where = join ' AND ', map { "`$_` = ?" } @keys;

    $self->{dbh}->do(
        "DELETE FROM $table WHERE $where", undef, @{$cond}{@keys},
    );
}

sub driver { $_[0]{driver} }

sub rand_function {
    my $self = shift;
    my $driver = $self->driver;
    if ( $driver eq 'sqlite' ) {
        return 'random()';
    }
    elsif ( $driver eq 'mysql' ) {
        return 'RAND()';
    }

    die "rand_function undefined for $driver\n";
}

1;
__END__