Got some basic functionality working. Still isn't fully functional (only the specifie...

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

diff --git a/lib/DBM/Deep/Storage/DBI.pm b/lib/DBM/Deep/Storage/DBI.pm
index b2c88a6..b86f809 100644 (file)
--- a/lib/DBM/Deep/Storage/DBI.pm
+++ b/lib/DBM/Deep/Storage/DBI.pm
@@ -7,6 +7,59 @@ 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};
+    }
+
+    $self->open unless $self->{dbh};
+
+    return $self;
+}
+
+sub open {
+    my $self = shift;
+
+    # TODO: Is this really what should happen?
+    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;
+
+    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;
@@ -24,5 +77,56 @@ sub unlock {
     my $self = shift;
 }
 
+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) = @_;
+
+    if ( $id ) {
+        $self->{dbh}->do(
+            "DELETE FROM $table WHERE id = $id",
+        );
+    }
+
+    my @keys = keys %args;
+    my $sql =
+        "INSERT INTO $table ( `id`, "
+          . join( ',', map { "`$_`" } @keys )
+      . ") VALUES ("
+          . join( ',', ('?') x (@keys + 1) )
+      . ")";
+    warn $sql. $/;
+    no warnings;
+    warn "@args{@keys}\n";
+    $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
+
+    return $self->{dbh}{mysql_insertid};
+}
+
+sub delete_from {
+    my $self = shift;
+    my ($table, $id) = @_;
+
+    $self->{dbh}->do(
+        "DELETE FROM $table WHERE id = ?", undef, $id,
+    );
+}
+
 1;
 __END__