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     if ( $self->{dbh} ) {
  29         $self->{driver} = lc $self->{dbh}->{Driver}->{Name};
  30     }
  31     else {
  32         $self->open;
  33     }
  34
  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
  42     return $self;
  43 }
  44
  45 sub open {
  46     my $self = shift;
  47
  48     return if $self->{dbh};
  49
  50     $self->{dbh} = DBI->connect(
  51         $self->{dbi}{dsn}, $self->{dbi}{username}, $self->{dbi}{password}, {
  52             AutoCommit => 1,
  53             PrintError => 0,
  54             RaiseError => 1,
  55             %{ $self->{dbi}{connect_args} || {} },
  56         },
  57     ) or die $DBI::error;
  58
  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
  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?
  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;
  92 #    $self->{dbh}->commit;
  93 }
  94
  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 #}
 109
 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
 131     my @keys = keys %args;
 132     my $sql =
 133         "REPLACE INTO $table ( `id`, "
 134           . join( ',', map { "`$_`" } @keys )
 135       . ") VALUES ("
 136           . join( ',', ('?') x (@keys + 1) )
 137       . ")";
 138     $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
 139
 140     return $self->{dbh}->last_insert_id("", "", "", "");
 141 }
 142
 143 sub delete_from {
 144     my $self = shift;
 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;
 151
 152     $self->{dbh}->do(
 153         "DELETE FROM $table WHERE $where", undef, @{$cond}{@keys},
 154     );
 155 }
 156
 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
 172 1;
 173 __END__