lib/DBM/Deep/Storage/DBI.pm

   1 package DBM::Deep::Storage::DBI;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 use base 'DBM::Deep::Storage';
   9
  10 use DBI;
  11
  12 sub new {
  13     my $class = shift;
  14     my ($args) = @_;
  15
  16     my $self = bless {
  17         autobless => 1,
  18         dbh       => undef,
  19         dbi       => undef,
  20     }, $class;
  21
  22     # Grab the parameters we want to use
  23     foreach my $param ( keys %$self ) {
  24         next unless exists $args->{$param};
  25         $self->{$param} = $args->{$param};
  26     }
  27
  28     $self->open unless $self->{dbh};
  29
  30     return $self;
  31 }
  32
  33 sub open {
  34     my $self = shift;
  35
  36     # TODO: Is this really what should happen?
  37     return if $self->{dbh};
  38
  39     $self->{dbh} = DBI->connect(
  40         $self->{dbi}{dsn}, $self->{dbi}{username}, $self->{dbi}{password}, {
  41             AutoCommit => 0,
  42             PrintError => 0,
  43             RaiseError => 1,
  44             %{ $self->{dbi}{connect_args} || {} },
  45         },
  46     ) or die $DBI::error;
  47
  48     return 1;
  49 }
  50
  51 sub close {
  52     my $self = shift;
  53     $self->{dbh}->disconnect if $self->{dbh};
  54     return 1;
  55 }
  56
  57 sub DESTROY {
  58     my $self = shift;
  59     $self->close if ref $self;
  60 }
  61
  62 # Is there a portable way of determining writability to a DBH?
  63 sub is_writable {
  64     my $self = shift;
  65     return 1;
  66 }
  67
  68 sub lock_exclusive {
  69     my $self = shift;
  70 }
  71
  72 sub lock_shared {
  73     my $self = shift;
  74 }
  75
  76 sub unlock {
  77     my $self = shift;
  78 }
  79
  80 sub read_from {
  81     my $self = shift;
  82     my ($table, $cond, @cols) = @_;
  83
  84     $cond = { id => $cond } unless ref $cond;
  85
  86     my @keys = keys %$cond;
  87     my $where = join ' AND ', map { "`$_` = ?" } @keys;
  88
  89     return $self->{dbh}->selectall_arrayref(
  90         "SELECT `@{[join '`,`', @cols ]}` FROM $table WHERE $where",
  91         { Slice => {} }, @{$cond}{@keys},
  92     );
  93 }
  94
  95 sub flush {}
  96
  97 sub write_to {
  98     my $self = shift;
  99     my ($table, $id, %args) = @_;
 100
 101     my @keys = keys %args;
 102     my $sql =
 103         "REPLACE INTO $table ( `id`, "
 104           . join( ',', map { "`$_`" } @keys )
 105       . ") VALUES ("
 106           . join( ',', ('?') x (@keys + 1) )
 107       . ")";
 108     $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
 109
 110     return $self->{dbh}{mysql_insertid};
 111 }
 112
 113 sub delete_from {
 114     my $self = shift;
 115     my ($table, $cond) = @_;
 116
 117     $cond = { id => $cond } unless ref $cond;
 118
 119     my @keys = keys %$cond;
 120     my $where = join ' AND ', map { "`$_` = ?" } @keys;
 121
 122     $self->{dbh}->do(
 123         "DELETE FROM $table WHERE $where", undef, @{$cond}{@keys},
 124     );
 125 }
 126
 127 1;
 128 __END__