Added supports() and rewrote the tests so that Engine::DBI doesn't run the transactio...

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index bf507fc..1ae5d39 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -379,6 +379,11 @@ sub clone {
     );
 }
 
+sub supports {
+    my $self = shift;
+    return $self->_engine->supports( @_ );
+}
+
 #XXX Migrate this to the engine, where it really belongs and go through some
 # API - stop poking in the innards of someone else..
 {

diff --git a/lib/DBM/Deep.pod b/lib/DBM/Deep.pod
index 1a8f24c..6d0a263 100644 (file)
--- a/lib/DBM/Deep.pod
+++ b/lib/DBM/Deep.pod
@@ -412,6 +412,17 @@ This copy is in RAM, not on disk like the DB is.
 
 These are the transactional functions. L</TRANSACTIONS> for more information.
 
+=item * supports( $option )
+
+This returns a boolean depending on if this instance of DBM::Dep supports
+that feature. C<$option> can be one of:
+
+=over 4
+
+=item * transactions
+
+=back
+
 =back
 
 =head2 Hashes

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 83d520f..ad6bff4 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -346,6 +346,21 @@ This is the cache of loaded Reference sectors.
 sub cache       { $_[0]{cache} ||= {} }
 sub clear_cache { %{$_[0]->cache} = () }
 
+=head2 supports( $option )
+
+This returns a boolean depending on if this instance of DBM::Dep supports
+that feature. C<$option> can be one of:
+
+=over 4
+
+=item * transactions
+
+=back
+
+=cut
+
+sub supports { die "supports must be implemented in a child class" }
+
 =head2 ACCESSORS
 
 The following are readonly attributes.

diff --git a/lib/DBM/Deep/Engine/DBI.pm b/lib/DBM/Deep/Engine/DBI.pm
index 6d7a533..4daf00b 100644 (file)
--- a/lib/DBM/Deep/Engine/DBI.pm
+++ b/lib/DBM/Deep/Engine/DBI.pm
@@ -311,21 +311,17 @@ sub write_value {
     return 1;
 }
 
-sub begin_work {
-    my $self = shift;
-    my ($obj) = @_;
-}
+sub begin_work { die "Transactions are not supported by thie engine" } 
+sub rollback   { die "Transactions are not supported by thie engine" } 
+sub commit     { die "Transactions are not supported by thie engine" }
 
-sub rollback {
-    my $self = shift;
-    my ($obj) = @_;
-}
+sub supports {
+    shift;
+    my ($feature) = @_;
 
-sub commit {
-    my $self = shift;
-    my ($obj) = @_;
+    return if $feature eq 'transactions';
+    return;
 }
 
-
 1;
 __END__

diff --git a/lib/DBM/Deep/Engine/File.pm b/lib/DBM/Deep/Engine/File.pm
index 846e389..f5145c4 100644 (file)
--- a/lib/DBM/Deep/Engine/File.pm
+++ b/lib/DBM/Deep/Engine/File.pm
@@ -1029,6 +1029,14 @@ sub set_trans_loc { $_[0]{trans_loc} = $_[1] }
 sub chains_loc     { $_[0]{chains_loc} }
 sub set_chains_loc { $_[0]{chains_loc} = $_[1] }
 
+sub supports {
+    shift;
+    my ($feature) = @_;
+
+    return 1 if $feature eq 'transactions';
+    return;
+}
+
 =head2 _dump_file()
 
 This method takes no arguments. It's used to print out a textual representation

diff --git a/t/33_transactions.t b/t/33_transactions.t
index 76609f9..3107cc0 100644 (file)
--- a/t/33_transactions.t
+++ b/t/33_transactions.t
@@ -8,11 +8,6 @@ use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 my $dbm_factory = new_dbm(
     locking => 1,
     autoflush => 1,
@@ -20,6 +15,8 @@ my $dbm_factory = new_dbm(
 );
 while ( my $dbm_maker = $dbm_factory->() ) {
     my $db1 = $dbm_maker->();
+    next unless $db1->supports( 'transactions' );
+
     my $db2 = $dbm_maker->();
 
     $db1->{x} = 'y';

diff --git a/t/34_transaction_arrays.t b/t/34_transaction_arrays.t
index 13b08f3..8513bbe 100644 (file)
--- a/t/34_transaction_arrays.t
+++ b/t/34_transaction_arrays.t
@@ -7,11 +7,6 @@ use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 my $dbm_factory = new_dbm(
     locking => 1,
     autoflush => 1,
@@ -20,6 +15,7 @@ my $dbm_factory = new_dbm(
 );
 while ( my $dbm_maker = $dbm_factory->() ) {
     my $db1 = $dbm_maker->();
+    next unless $db1->supports( 'transactions' );
     my $db2 = $dbm_maker->();
 
     $db1->[0] = 'y';

diff --git a/t/35_transaction_multiple.t b/t/35_transaction_multiple.t
index 3dc039a..61505f1 100644 (file)
--- a/t/35_transaction_multiple.t
+++ b/t/35_transaction_multiple.t
@@ -7,19 +7,14 @@ use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 my $dbm_factory = new_dbm(
     locking => 1,
     autoflush => 1,
     num_txns  => 16,
 );
-
 while ( my $dbm_maker = $dbm_factory->() ) {
     my $db1 = $dbm_maker->();
+    next unless $db1->supports( 'transactions' );
     my $db2 = $dbm_maker->();
     my $db3 = $dbm_maker->();
 

diff --git a/t/41_transaction_multilevel.t b/t/41_transaction_multilevel.t
index c1ce955..790fa36 100644 (file)
--- a/t/41_transaction_multilevel.t
+++ b/t/41_transaction_multilevel.t
@@ -5,11 +5,6 @@ use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 my $dbm_factory = new_dbm(
     locking   => 1,
     autoflush => 1,
@@ -17,6 +12,7 @@ my $dbm_factory = new_dbm(
 );
 while ( my $dbm_maker = $dbm_factory->() ) {
     my $db1 = $dbm_maker->();
+    next unless $db1->supports('transactions');
     my $db2 = $dbm_maker->();
 
     $db1->{x} = { xy => { foo => 'y' } };

diff --git a/t/42_transaction_indexsector.t b/t/42_transaction_indexsector.t
index 44bb375..39274fc 100644 (file)
--- a/t/42_transaction_indexsector.t
+++ b/t/42_transaction_indexsector.t
@@ -14,11 +14,6 @@ use_ok( 'DBM::Deep' );
 # reindexing at 17 keys vs. attempting to hit the second-level reindex which
 # can occur as early as 18 keys and as late as 4097 (256*16+1) keys.
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 {
     my $dbm_factory = new_dbm(
         locking => 1,
@@ -27,6 +22,7 @@ if ( $ENV{NO_TEST_TRANSACTIONS} ) {
     );
     while ( my $dbm_maker = $dbm_factory->() ) {
         my $db1 = $dbm_maker->();
+        next unless $db1->supports( 'transactions' );
         my $db2 = $dbm_maker->();
 
         $db1->{x} = 'y';
@@ -62,6 +58,7 @@ if ( $ENV{NO_TEST_TRANSACTIONS} ) {
     );
     while ( my $dbm_maker = $dbm_factory->() ) {
         my $db1 = $dbm_maker->();
+        next unless $db1->supports( 'transactions' );
         my $db2 = $dbm_maker->();
 
         $db1->{x} = 'y';

diff --git a/t/43_transaction_maximum.t b/t/43_transaction_maximum.t
index cbefd48..2998cea 100644 (file)
--- a/t/43_transaction_maximum.t
+++ b/t/43_transaction_maximum.t
@@ -10,19 +10,16 @@ use_ok( 'DBM::Deep' );
 
 my $max_txns = 255;
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 my $dbm_factory = new_dbm(
     num_txns  => $max_txns,
 );
 while ( my $dbm_maker = $dbm_factory->() ) {
-    my @dbs = grep { $_ } map {
-        eval { $dbm_maker->() }
-    } 1 .. $max_txns;
+    my @dbs = ( $dbm_maker->() );
+    next unless $dbs[0]->supports('transactions');
 
+    push @dbs, grep { $_ } map {
+        eval { $dbm_maker->() }
+    } 2 .. $max_txns;
 
     cmp_ok( scalar(@dbs), '==', $max_txns, "We could open enough DB handles" );
 

diff --git a/t/45_references.t b/t/45_references.t
index 0a1a061..b37f8f9 100644 (file)
--- a/t/45_references.t
+++ b/t/45_references.t
@@ -7,11 +7,6 @@ use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
-if ( $ENV{NO_TEST_TRANSACTIONS} ) {
-    done_testing;
-    exit;
-}
-
 my $dbm_factory = new_dbm(
     locking => 1,
     autoflush => 1,
@@ -19,6 +14,7 @@ my $dbm_factory = new_dbm(
 );
 while ( my $dbm_maker = $dbm_factory->() ) {
     my $db1 = $dbm_maker->();
+    next unless $db1->supports( 'transactions' );
     my $db2 = $dbm_maker->();
 
     $db1->{foo} = 5;