X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep%2FStorage%2FDBI.pm;h=b86f8096b41351120ece3d8cfc4540bdbaadc8c3;hb=a4d36ff61c367864cdf95523dd9771b01773930c;hp=b2c88a6fc81cf0bafcfce3655f54bd8482dc739d;hpb=18bc2fa6f00cd17c961f2a7fe94296fefbf569c4;p=dbsrgits%2FDBM-Deep.git diff --git a/lib/DBM/Deep/Storage/DBI.pm b/lib/DBM/Deep/Storage/DBI.pm index b2c88a6..b86f809 100644 --- 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__