Commit | Line | Data |
2c70efe1 |
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 | |
a4d36ff6 |
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 | |
bac1b5d5 |
28 | if ( $self->{dbh} ) { |
29 | $self->{driver} = lc $self->{dbh}->{Driver}->{Name}; |
30 | } |
31 | else { |
32 | $self->open; |
33 | } |
a4d36ff6 |
34 | |
7c927437 |
35 | # Foreign keys are turned off by default in SQLite3 (for now) |
36 | #q.v. http://search.cpan.org/~adamk/DBD-SQLite-1.27/lib/DBD/SQLite.pm#Foreign_Keys |
37 | # for more info. |
38 | if ( $self->driver eq 'sqlite' ) { |
39 | $self->{dbh}->do( 'PRAGMA foreign_keys = ON' ); |
40 | } |
41 | |
a4d36ff6 |
42 | return $self; |
43 | } |
44 | |
45 | sub open { |
46 | my $self = shift; |
47 | |
a4d36ff6 |
48 | return if $self->{dbh}; |
49 | |
50 | $self->{dbh} = DBI->connect( |
51 | $self->{dbi}{dsn}, $self->{dbi}{username}, $self->{dbi}{password}, { |
bd6b4f3c |
52 | AutoCommit => 1, |
a4d36ff6 |
53 | PrintError => 0, |
54 | RaiseError => 1, |
55 | %{ $self->{dbi}{connect_args} || {} }, |
56 | }, |
57 | ) or die $DBI::error; |
58 | |
bac1b5d5 |
59 | # Should we use the same method as done in new() if passed a $dbh? |
60 | (undef, $self->{driver}) = map lc, DBI->parse_dsn( $self->{dbi}{dsn} ); |
61 | |
a4d36ff6 |
62 | return 1; |
63 | } |
64 | |
65 | sub close { |
66 | my $self = shift; |
67 | $self->{dbh}->disconnect if $self->{dbh}; |
68 | return 1; |
69 | } |
70 | |
71 | sub DESTROY { |
72 | my $self = shift; |
73 | $self->close if ref $self; |
74 | } |
75 | |
76 | # Is there a portable way of determining writability to a DBH? |
2c70efe1 |
77 | sub is_writable { |
78 | my $self = shift; |
79 | return 1; |
80 | } |
81 | |
82 | sub lock_exclusive { |
83 | my $self = shift; |
84 | } |
85 | |
86 | sub lock_shared { |
87 | my $self = shift; |
88 | } |
89 | |
90 | sub unlock { |
91 | my $self = shift; |
c1b375a1 |
92 | # $self->{dbh}->commit; |
2c70efe1 |
93 | } |
94 | |
417f635b |
95 | #sub begin_work { |
96 | # my $self = shift; |
97 | # $self->{dbh}->begin_work; |
98 | #} |
99 | # |
100 | #sub commit { |
101 | # my $self = shift; |
102 | # $self->{dbh}->commit; |
103 | #} |
104 | # |
105 | #sub rollback { |
106 | # my $self = shift; |
107 | # $self->{dbh}->rollback; |
108 | #} |
bd6b4f3c |
109 | |
a4d36ff6 |
110 | sub read_from { |
111 | my $self = shift; |
112 | my ($table, $cond, @cols) = @_; |
113 | |
114 | $cond = { id => $cond } unless ref $cond; |
115 | |
116 | my @keys = keys %$cond; |
117 | my $where = join ' AND ', map { "`$_` = ?" } @keys; |
118 | |
119 | return $self->{dbh}->selectall_arrayref( |
120 | "SELECT `@{[join '`,`', @cols ]}` FROM $table WHERE $where", |
121 | { Slice => {} }, @{$cond}{@keys}, |
122 | ); |
123 | } |
124 | |
125 | sub flush {} |
126 | |
127 | sub write_to { |
128 | my $self = shift; |
129 | my ($table, $id, %args) = @_; |
130 | |
a4d36ff6 |
131 | my @keys = keys %args; |
132 | my $sql = |
350896ee |
133 | "REPLACE INTO $table ( `id`, " |
a4d36ff6 |
134 | . join( ',', map { "`$_`" } @keys ) |
135 | . ") VALUES (" |
136 | . join( ',', ('?') x (@keys + 1) ) |
137 | . ")"; |
a4d36ff6 |
138 | $self->{dbh}->do( $sql, undef, $id, @args{@keys} ); |
139 | |
bac1b5d5 |
140 | return $self->{dbh}->last_insert_id("", "", "", ""); |
a4d36ff6 |
141 | } |
142 | |
143 | sub delete_from { |
144 | my $self = shift; |
350896ee |
145 | my ($table, $cond) = @_; |
146 | |
147 | $cond = { id => $cond } unless ref $cond; |
148 | |
149 | my @keys = keys %$cond; |
150 | my $where = join ' AND ', map { "`$_` = ?" } @keys; |
a4d36ff6 |
151 | |
152 | $self->{dbh}->do( |
350896ee |
153 | "DELETE FROM $table WHERE $where", undef, @{$cond}{@keys}, |
a4d36ff6 |
154 | ); |
155 | } |
156 | |
bac1b5d5 |
157 | sub driver { $_[0]{driver} } |
158 | |
159 | sub rand_function { |
160 | my $self = shift; |
161 | my $driver = $self->driver; |
162 | if ( $driver eq 'sqlite' ) { |
163 | return 'random()'; |
164 | } |
165 | elsif ( $driver eq 'mysql' ) { |
166 | return 'RAND()'; |
167 | } |
168 | |
169 | die "rand_function undefined for $driver\n"; |
170 | } |
171 | |
2c70efe1 |
172 | 1; |
173 | __END__ |