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     if ( $id ) {
 102         $self->{dbh}->do(
 103             "DELETE FROM $table WHERE id = $id",
 104         );
 105     }
 106
 107     my @keys = keys %args;
 108     my $sql =
 109         "INSERT INTO $table ( `id`, "
 110           . join( ',', map { "`$_`" } @keys )
 111       . ") VALUES ("
 112           . join( ',', ('?') x (@keys + 1) )
 113       . ")";
 114     warn $sql. $/;
 115     no warnings;
 116     warn "@args{@keys}\n";
 117     $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
 118
 119     return $self->{dbh}{mysql_insertid};
 120 }
 121
 122 sub delete_from {
 123     my $self = shift;
 124     my ($table, $id) = @_;
 125
 126     $self->{dbh}->do(
 127         "DELETE FROM $table WHERE id = ?", undef, $id,
 128     );
 129 }
 130
 131 1;
 132 __END__