From: Rob Kinyon Date: Wed, 30 Dec 2009 22:29:04 +0000 (-0500) Subject: All tests pass except for the transaction tests under MySQL. InnoDB sucks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4f034d8ffdf4d853f8f098344c5e703eb7fe32b5;p=dbsrgits%2FDBM-Deep.git All tests pass except for the transaction tests under MySQL. InnoDB sucks --- diff --git a/etc/mysql_tables.sql b/etc/mysql_tables.sql index 840b0b8..1f4cb58 100644 --- a/etc/mysql_tables.sql +++ b/etc/mysql_tables.sql @@ -6,7 +6,7 @@ CREATE TABLE refs ( ,ref_type ENUM( 'H', 'A' ) NOT NULL DEFAULT 'H' ,refcount BIGINT UNSIGNED NOT NULL DEFAULT 1 ,classname LONGTEXT -); +) ENGINE=MyISAM; CREATE TABLE datas ( id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY @@ -16,5 +16,5 @@ CREATE TABLE datas ( ,value LONGTEXT ,FOREIGN KEY (ref_id) REFERENCES refs (id) ON DELETE CASCADE ON UPDATE CASCADE - ,UNIQUE INDEX (ref_id, `key` (900) ) -); + ,UNIQUE INDEX (ref_id, `key` (700) ) +) ENGINE=MyISAM; diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 999a65c..83d520f 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -337,6 +337,15 @@ defined sector type. sub load_sector { $_[0]->sector_type->load( @_ ) } +=head2 cache / clear_cache + +This is the cache of loaded Reference sectors. + +=cut + +sub cache { $_[0]{cache} ||= {} } +sub clear_cache { %{$_[0]->cache} = () } + =head2 ACCESSORS The following are readonly attributes. @@ -345,6 +354,8 @@ The following are readonly attributes. =item * storage +=item * sector_type + =back =cut diff --git a/lib/DBM/Deep/Engine/File.pm b/lib/DBM/Deep/Engine/File.pm index cda6128..846e389 100644 --- a/lib/DBM/Deep/Engine/File.pm +++ b/lib/DBM/Deep/Engine/File.pm @@ -1029,9 +1029,6 @@ sub set_trans_loc { $_[0]{trans_loc} = $_[1] } sub chains_loc { $_[0]{chains_loc} } sub set_chains_loc { $_[0]{chains_loc} = $_[1] } -sub cache { $_[0]{cache} ||= {} } -sub clear_cache { %{$_[0]->cache} = () } - =head2 _dump_file() This method takes no arguments. It's used to print out a textual representation diff --git a/lib/DBM/Deep/Sector/DBI/Reference.pm b/lib/DBM/Deep/Sector/DBI/Reference.pm index 761f268..290bec1 100644 --- a/lib/DBM/Deep/Sector/DBI/Reference.pm +++ b/lib/DBM/Deep/Sector/DBI/Reference.pm @@ -106,24 +106,29 @@ sub get_classname { return $rows->[0]{classname}; } +# Look to hoist this method into a ::Reference trait sub data { my $self = shift; my ($args) = @_; $args ||= {}; - my $obj = DBM::Deep->new({ - type => $self->type, - base_offset => $self->offset, -# staleness => $self->staleness, - storage => $self->engine->storage, - engine => $self->engine, - }); - - if ( $self->engine->storage->{autobless} ) { - my $classname = $self->get_classname; - if ( defined $classname ) { - bless $obj, $classname; + my $obj; + unless ( $obj = $self->engine->cache->{ $self->offset } ) { + $obj = DBM::Deep->new({ + type => $self->type, + base_offset => $self->offset, + storage => $self->engine->storage, + engine => $self->engine, + }); + + if ( $self->engine->storage->{autobless} ) { + my $classname = $self->get_classname; + if ( defined $classname ) { + bless $obj, $classname; + } } + + $self->engine->cache->{$self->offset} = $obj; } # We're not exporting, so just return. @@ -143,9 +148,13 @@ sub free { my $self = shift; # We're not ready to be removed yet. - if ( $self->decrement_refcount > 0 ) { - return; - } + return if $self->decrement_refcount > 0; + + # Rebless the object into DBM::Deep::Null. + eval { %{ $self->engine->cache->{ $self->offset } } = (); }; + eval { @{ $self->engine->cache->{ $self->offset } } = (); }; + bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null'; + delete $self->engine->cache->{ $self->offset }; $self->engine->storage->delete_from( 'datas', { ref_id => $self->offset }, diff --git a/lib/DBM/Deep/Sector/DBI/Scalar.pm b/lib/DBM/Deep/Sector/DBI/Scalar.pm index 4d5d41b..276e66c 100644 --- a/lib/DBM/Deep/Sector/DBI/Scalar.pm +++ b/lib/DBM/Deep/Sector/DBI/Scalar.pm @@ -27,23 +27,5 @@ sub data { $self->{value}; } -=pod -sub write_data { - my $self = shift; - my ($args) = @_; - - $self->engine->storage->write_to( - datas => $args->{value}{offset}, - ref_id => $self->offset, - data_type => 'S', - key => $args->{key}, - value => $args->{value}{value}, - class => $args->{value}{class}, - ); - - $args->{value}->reload; -} -=cut - 1; __END__ diff --git a/lib/DBM/Deep/Sector/File/Reference.pm b/lib/DBM/Deep/Sector/File/Reference.pm index c2e2271..5b4ee12 100644 --- a/lib/DBM/Deep/Sector/File/Reference.pm +++ b/lib/DBM/Deep/Sector/File/Reference.pm @@ -408,6 +408,7 @@ sub get_classname { return $self->engine->load_sector( $class_offset )->data; } +# Look to hoist this method into a ::Reference trait sub data { my $self = shift; my ($args) = @_; @@ -450,9 +451,7 @@ sub free { my $self = shift; # We're not ready to be removed yet. - if ( $self->decrement_refcount > 0 ) { - return; - } + return if $self->decrement_refcount > 0; # Rebless the object into DBM::Deep::Null. eval { %{ $self->engine->cache->{ $self->offset } } = (); }; diff --git a/t/04_array.t b/t/04_array.t index 4f049ad..07c9763 100644 --- a/t/04_array.t +++ b/t/04_array.t @@ -14,17 +14,11 @@ while ( my $dbm_maker = $dbm_factory->() ) { ## # basic put/get/push ## -warn "1\n"; $db->[0] = "elem1"; -warn "2\n"; $db->push( "elem2" ); -warn "3\n"; $db->put(2, "elem3"); -warn "4\n"; $db->store(3, "elem4"); -warn "5\n"; $db->unshift("elem0"); -warn "6\n"; is( $db->[0], 'elem0', "Array get for shift works" ); is( $db->[1], 'elem1', "Array get for array set works" ); diff --git a/t/33_transactions.t b/t/33_transactions.t index a4ca5c3..76609f9 100644 --- a/t/33_transactions.t +++ b/t/33_transactions.t @@ -8,6 +8,11 @@ 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, diff --git a/t/34_transaction_arrays.t b/t/34_transaction_arrays.t index 7789815..13b08f3 100644 --- a/t/34_transaction_arrays.t +++ b/t/34_transaction_arrays.t @@ -7,6 +7,11 @@ 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, diff --git a/t/35_transaction_multiple.t b/t/35_transaction_multiple.t index 4011618..3dc039a 100644 --- a/t/35_transaction_multiple.t +++ b/t/35_transaction_multiple.t @@ -7,6 +7,11 @@ 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, diff --git a/t/41_transaction_multilevel.t b/t/41_transaction_multilevel.t index b392144..c1ce955 100644 --- a/t/41_transaction_multilevel.t +++ b/t/41_transaction_multilevel.t @@ -5,6 +5,11 @@ 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, diff --git a/t/42_transaction_indexsector.t b/t/42_transaction_indexsector.t index 3111b38..44bb375 100644 --- a/t/42_transaction_indexsector.t +++ b/t/42_transaction_indexsector.t @@ -14,6 +14,11 @@ 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, diff --git a/t/43_transaction_maximum.t b/t/43_transaction_maximum.t index 6a1c7a6..cbefd48 100644 --- a/t/43_transaction_maximum.t +++ b/t/43_transaction_maximum.t @@ -10,6 +10,11 @@ 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, ); diff --git a/t/45_references.t b/t/45_references.t index 6ca724b..0a1a061 100644 --- a/t/45_references.t +++ b/t/45_references.t @@ -7,6 +7,11 @@ 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, @@ -65,15 +70,10 @@ while ( my $dbm_maker = $dbm_factory->() ) { done_testing; __END__ -warn "-2\n"; $db2->begin_work; -warn "-1\n"; delete $db2->{bar}; -warn "0\n"; $db2->commit; -warn "1\n"; ok( !exists $db1->{bar}, "After commit, bar is gone" ); -warn "2\n";