From: Rob Kinyon Date: Sun, 3 Jan 2010 03:41:06 +0000 (-0500) Subject: First pass at SQLite support. Have everything through t/18 passing with all three... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bac1b5d53d59b14a5eae94c1365e4ad932e733a5;p=dbsrgits%2FDBM-Deep.git First pass at SQLite support. Have everything through t/18 passing with all three engines. --- diff --git a/Build.PL b/Build.PL index d5e0f76..b02ca6b 100644 --- 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 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 --- 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 --- 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 --- 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 --- 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 {