First pass at SQLite support. Have everything through t/18 passing with all three...

diff --git a/Build.PL b/Build.PL
index d5e0f76..b02ca6b 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -14,10 +14,9 @@ sub ACTION_test {
             TEST_MYSQL_DSN TEST_MYSQL_USER TEST_MYSQL_PASS
         );
     }
-    if ( $self->notes( 'LONG_TESTS' ) ) {
-        $ENV{LONG_TESTS} = 1;
+    foreach my $name ( qw( LONG_TESTS TEST_SQLITE ) ) {
+        $ENV{$name} = 1 if $self->notes( $name );
     }
-    $self->SUPER::ACTION_test;
 }
 SUBCLASS
 
@@ -46,8 +45,15 @@ my $build = $class->new(
     ],
     test_files => 't/??_*.t',
     auto_features => {
-        dbi_engine => {
-            description => 'DBI support (mysql only so far)',
+        sqlite_engine => {
+            description => 'DBI support via SQLite',
+            requires => {
+                'DBI'         => '1.5',
+                'DBD::SQLite' => '1.25',
+            },
+        },
+        mysql_engine => {
+            description => 'DBI support via MySQL',
             requires => {
                 'DBI'        => '1.5',
                 'DBD::mysql' => '4.001',
@@ -60,8 +66,14 @@ if ( $build->y_n( "Run the long-running tests", 'n' ) ) {
     $build->notes( 'LONG_TESTS' => 1 );
 }
 
-if ( $build->features( 'dbi_engine' ) ) {
-    if ( $build->y_n( "Run the tests against the DBI engine (for MySQL only)?", 'n' ) ) {
+if ( $build->features( 'sqlite_engine' ) ) {
+    if ( $build->y_n( "Run the tests against the DBI engine via SQLite?", 'n' ) ) {
+        $build->notes( 'TEST_SQLITE' => 1 );
+    }
+}
+
+if ( $build->features( 'mysql_engine' ) ) {
+    if ( $build->y_n( "Run the tests against the DBI engine via MySQL?", 'n' ) ) {
         my ($dsn, $user, $pass) = ('') x 3;
         $dsn = $build->prompt( "\tWhat is the full DSN (for example 'dbi:mysql:test')" );
         if ( $dsn ) {

diff --git a/etc/sqlite_tables.sql b/etc/sqlite_tables.sql
new file mode 100644 (file)
index 0000000..975bdbc
--- /dev/null
+++ b/etc/sqlite_tables.sql
@@ -0,0 +1,20 @@
+DROP TABLE IF EXISTS datas;
+DROP TABLE IF EXISTS refs;
+
+CREATE TABLE refs (
+    id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT
+   ,ref_type STRING NOT NULL DEFAULT 'H'
+   ,refcount INTEGER NOT NULL DEFAULT 1
+   ,classname STRING
+);
+
+CREATE TABLE datas (
+    id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT
+   ,ref_id INTEGER NOT NULL
+   ,data_type STRING DEFAULT 'S'
+   ,`key` STRING NOT NULL
+   ,value STRING
+   ,FOREIGN KEY (ref_id) REFERENCES refs (id)
+        ON DELETE CASCADE ON UPDATE CASCADE
+   ,UNIQUE (ref_id, `key` )
+);

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index b595076..fdb20d6 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings FATAL => 'all';
 
-our $VERSION = q(1.0019_001);
+our $VERSION = q(1.0019_002);
 
 use Scalar::Util ();
 

diff --git a/lib/DBM/Deep/Iterator/DBI.pm b/lib/DBM/Deep/Iterator/DBI.pm
index 31ec7b8..0aecbe8 100644 (file)
--- a/lib/DBM/Deep/Iterator/DBI.pm
+++ b/lib/DBM/Deep/Iterator/DBI.pm
@@ -19,8 +19,12 @@ sub get_next_key {
     my ($obj) = @_;
 
     unless ( exists $self->{sth} ) {
-        $self->{sth} = $self->{engine}->storage->{dbh}->prepare(
-            "SELECT `key` FROM datas WHERE ref_id = ? ORDER BY RAND()",
+        # For mysql, this needs to be RAND()
+        # For sqlite, this needs to be random()
+        my $storage = $self->{engine}->storage;
+        $self->{sth} = $storage->{dbh}->prepare(
+            "SELECT `key` FROM datas WHERE ref_id = ? ORDER BY "
+          . $storage->rand_function,
         );
         $self->{sth}->execute( $self->{base_offset} );
     }

diff --git a/lib/DBM/Deep/Storage/DBI.pm b/lib/DBM/Deep/Storage/DBI.pm
index 2357221..633fc16 100644 (file)
--- a/lib/DBM/Deep/Storage/DBI.pm
+++ b/lib/DBM/Deep/Storage/DBI.pm
@@ -25,7 +25,12 @@ sub new {
         $self->{$param} = $args->{$param};
     }
 
-    $self->open unless $self->{dbh};
+    if ( $self->{dbh} ) {
+        $self->{driver} = lc $self->{dbh}->{Driver}->{Name};
+    }
+    else {
+        $self->open;
+    }
 
     return $self;
 }
@@ -33,7 +38,6 @@ sub new {
 sub open {
     my $self = shift;
 
-    # TODO: Is this really what should happen?
     return if $self->{dbh};
 
     $self->{dbh} = DBI->connect(
@@ -45,6 +49,9 @@ sub open {
         },
     ) or die $DBI::error;
 
+    # Should we use the same method as done in new() if passed a $dbh?
+    (undef, $self->{driver}) = map lc, DBI->parse_dsn( $self->{dbi}{dsn} );
+
     return 1;
 }
 
@@ -75,6 +82,7 @@ sub lock_shared {
 
 sub unlock {
     my $self = shift;
+    $self->{dbh}->commit;
 }
 
 sub read_from {
@@ -107,7 +115,7 @@ sub write_to {
       . ")";
     $self->{dbh}->do( $sql, undef, $id, @args{@keys} );
 
-    return $self->{dbh}{mysql_insertid};
+    return $self->{dbh}->last_insert_id("", "", "", "");
 }
 
 sub delete_from {
@@ -124,5 +132,20 @@ sub delete_from {
     );
 }
 
+sub driver { $_[0]{driver} }
+
+sub rand_function {
+    my $self = shift;
+    my $driver = $self->driver;
+    if ( $driver eq 'sqlite' ) {
+        return 'random()';
+    }
+    elsif ( $driver eq 'mysql' ) {
+        return 'RAND()';
+    }
+
+    die "rand_function undefined for $driver\n";
+}
+
 1;
 __END__

diff --git a/t/common.pm b/t/common.pm
index 0103885..08638be 100644 (file)
--- a/t/common.pm
+++ b/t/common.pm
@@ -35,16 +35,37 @@ sub new_dbm {
 
     unless ( $ENV{NO_TEST_FILE} ) {
         push @reset_funcs, undef;
-        push @extra_args, (
-            [ file => $filename ],
-        );
+        push @extra_args, [
+            file => $filename,
+        ];
     }
 
-#    eval { require DBD::SQLite; };
-#    unless ( $@ ) {
-#        push @extra_args, [
-#        ];
-#    }
+    if ( $ENV{TEST_SQLITE} ) {
+        (undef, my $filename) = new_fh();
+        $filename = 'test.db';
+        push @reset_funcs, sub {
+            my $dbh = DBI->connect(
+                "dbi:SQLite:dbname=$filename", '', '',
+            );
+            my $sql = do {
+                my $filename = 'etc/sqlite_tables.sql';
+                open my $fh, '<', $filename
+                    or die "Cannot open '$filename' for reading: $!\n";
+                local $/;
+                <$fh>
+            };
+            foreach my $line ( split ';', $sql ) {
+                $dbh->do( "$line" ) if $line =~ /\S/;
+            }
+        };
+        push @extra_args, [
+            dbi => {
+                dsn      => "dbi:SQLite:dbname=$filename",
+                user     => '',
+                password => '',
+            },
+        ];
+    }
 
     if ( $ENV{TEST_MYSQL_DSN} ) {
         push @reset_funcs, sub {