da5c89ea1cbe69a5e88f9e73ebd6ae5a722ccfb0
[dbsrgits/DBM-Deep.git] / 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 #warn $sql. $/;
109 #no warnings;
110 #warn "@args{@keys}\n";
111     $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
112
113     return $self->{dbh}{mysql_insertid};
114 }
115
116 sub delete_from {
117     my $self = shift;
118     my ($table, $cond) = @_;
119
120     $cond = { id => $cond } unless ref $cond;
121
122     my @keys = keys %$cond;
123     my $where = join ' AND ', map { "`$_` = ?" } @keys;
124
125     $self->{dbh}->do(
126         "DELETE FROM $table WHERE $where", undef, @{$cond}{@keys},
127     );
128 }
129
130 1;
131 __END__