From: Rob Kinyon Date: Fri, 25 Dec 2009 22:21:07 +0000 (-0500) Subject: Got some basic functionality working. Still isn't fully functional (only the specifie... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a4d36ff61c367864cdf95523dd9771b01773930c;p=dbsrgits%2FDBM-Deep.git Got some basic functionality working. Still isn't fully functional (only the specified tests in t/02_hash.t work). --- diff --git a/etc/mysql_tables.sql b/etc/mysql_tables.sql index 7a30a53..ab9674a 100644 --- a/etc/mysql_tables.sql +++ b/etc/mysql_tables.sql @@ -1,74 +1,20 @@ -DROP TABLE IF EXISTS references; -CREATE TABLE references ( +DROP TABLE IF EXISTS datas; +DROP TABLE IF EXISTS refs; + +CREATE TABLE refs ( id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY - ,`type` ENUM( 'hash', 'array' ) NOT NULL DEFAULT 'hash' + ,ref_type ENUM( 'H', 'A' ) NOT NULL DEFAULT 'H' ,refcount BIGINT UNSIGNED NOT NULL DEFAULT 1 ); -DROP TABLE IF EXISTS datas; -CREATE TABLE data ( +CREATE TABLE datas ( id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY - ,reference_id BIGINT UNSIGNED NOT NULL - ,key TEXT NOT NULL + ,ref_id BIGINT UNSIGNED NOT NULL + ,data_type ENUM( 'S', 'R' ) DEFAULT 'S' + ,`key` TEXT NOT NULL ,value TEXT ,class TEXT - ,FOREIGN KEY (reference_id) REFERENCES references (id) + ,FOREIGN KEY (ref_id) REFERENCES refs (id) + ON DELETE CASCADE ON UPDATE CASCADE + ,UNIQUE INDEX (ref_id, `key` (900) ) ); - ---DROP TABLE IF EXISTS `rec_array`; ---CREATE TABLE `rec_array` ( --- `id` bigint(20) unsigned NOT NULL, --- PRIMARY KEY (`id`) ---); --- ---DROP TABLE IF EXISTS `rec_array_item`; ---CREATE TABLE `rec_array_item` ( --- `id` bigint(20) unsigned NOT NULL AUTO_INCREMENT, --- `array` bigint(20) NOT NULL, --- `pos` bigint(20) NOT NULL, --- `value_data` varchar(255) DEFAULT NULL, --- `value_type` enum('array','data','hash','text','value') NOT NULL DEFAULT 'value', --- PRIMARY KEY (`id`), --- UNIQUE KEY `array_2` (`array`,`pos`) ---); --- ---DROP TABLE IF EXISTS `rec_hash`; ---CREATE TABLE `rec_hash` ( --- `id` bigint(20) unsigned NOT NULL, --- PRIMARY KEY (`id`) ---); --- ---DROP TABLE IF EXISTS `rec_hash_item`; ---CREATE TABLE `rec_hash_item` ( --- `id` bigint(20) unsigned NOT NULL AUTO_INCREMENT, --- `hash` bigint(20) NOT NULL, --- `key_data` varchar(255) DEFAULT NULL, --- `key_hash` varchar(22) NOT NULL, --- `key_type` enum('text','value') NOT NULL DEFAULT 'value', --- `value_data` varchar(255) DEFAULT NULL, --- `value_type` enum('array','data','hash','text','value') NOT NULL DEFAULT 'value', --- PRIMARY KEY (`id`), --- UNIQUE KEY `hash_2` (`hash`,`key_hash`) ---); --- ---DROP TABLE IF EXISTS `rec_item`; ---CREATE TABLE `rec_item` ( --- `id` bigint(20) NOT NULL AUTO_INCREMENT, --- `item_type` enum('array','hash') NOT NULL DEFAULT 'hash', --- PRIMARY KEY (`id`) ---); --- ---DROP TABLE IF EXISTS `rec_value_data`; ---CREATE TABLE `rec_value_data` ( --- `id` bigint(20) unsigned NOT NULL AUTO_INCREMENT, --- `data` longblob NOT NULL, --- PRIMARY KEY (`id`) ---); --- ---DROP TABLE IF EXISTS `rec_value_text`; ---CREATE TABLE `rec_value_text` ( --- `id` bigint(20) unsigned NOT NULL AUTO_INCREMENT, --- `data` longtext NOT NULL, --- PRIMARY KEY (`id`) ---); --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 3998791..94c296f 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -9,6 +9,7 @@ our $VERSION = q(1.0015); use Scalar::Util (); +use DBM::Deep::Engine::DBI (); use DBM::Deep::Engine::File (); use DBM::Deep::SQL::Util; @@ -56,6 +57,7 @@ sub new { my $args = $class->_get_args( @_ ); my $self; +=pod if (exists $args->{dbi}) { eval { require DBIx::Abstract; @@ -117,6 +119,7 @@ sub new { return bless $self, $class; } } +=cut ## # Check if we want a tied hash or array. diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 094f51c..6e6147e 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -13,6 +13,9 @@ use DBM::Deep::Iterator (); # mutex. But, it's the caller's responsability to make sure that this has # been done. +sub SIG_HASH () { 'H' } +sub SIG_ARRAY () { 'A' } + =head1 NAME DBM::Deep::Engine diff --git a/lib/DBM/Deep/Engine/DBI.pm b/lib/DBM/Deep/Engine/DBI.pm index 434fafe..39e7246 100644 --- a/lib/DBM/Deep/Engine/DBI.pm +++ b/lib/DBM/Deep/Engine/DBI.pm @@ -12,13 +12,90 @@ use DBM::Deep::Storage::DBI (); sub sector_type { 'DBM::Deep::Sector::DBI' } -__END__ +sub new { + my $class = shift; + my ($args) = @_; + + $args->{storage} = DBM::Deep::Storage::DBI->new( $args ) + unless exists $args->{storage}; + + my $self = bless { + storage => undef, + }, $class; + + # Grab the parameters we want to use + foreach my $param ( keys %$self ) { + next unless exists $args->{$param}; + $self->{$param} = $args->{$param}; + } + + return $self; +} + +sub setup { + my $self = shift; + my ($obj) = @_; + + # Default the id to 1. This means that we will be creating a row if there + # isn't one. The assumption is that the row_id=1 cannot never be deleted. I + # don't know if this is a good assumption. + $obj->{base_offset} ||= 1; + + my ($rows) = $self->storage->read_from( + refs => $obj->_base_offset, + qw( ref_type ), + ); + + # We don't have a row yet. + unless ( @$rows ) { + $self->storage->write_to( + refs => $obj->_base_offset, + ref_type => $obj->_type, + ); + } + + my $sector = DBM::Deep::Sector::DBI::Reference->new({ + engine => $self, + offset => $obj->_base_offset, + }); +} sub read_value { my $self = shift; my ($obj, $key) = @_; + + my $sector = $self->load_sector( $obj->_base_offset, 'refs' ) + or return; + +# if ( $sector->staleness != $obj->_staleness ) { +# return; +# } + +# my $key_md5 = $self->_apply_digest( $key ); + + my $value_sector = $sector->get_data_for({ + key => $key, +# key_md5 => $key_md5, + allow_head => 1, + }); + + unless ( $value_sector ) { + $value_sector = DBM::Deep::Sector::DBI::Scalar->new({ + engine => $self, + data => undef, + }); + + $sector->write_data({ +# key_md5 => $key_md5, + key => $key, + value => $value_sector, + }); + } + + return $value_sector->data; } +=pod sub get_classname { my $self = shift; my ($obj) = @_; @@ -28,15 +105,46 @@ sub make_reference { my $self = shift; my ($obj, $old_key, $new_key) = @_; } +=cut +# exists returns '', not undefined. sub key_exists { my $self = shift; my ($obj, $key) = @_; + + my $sector = $self->load_sector( $obj->_base_offset, 'refs' ) + or return ''; + +# if ( $sector->staleness != $obj->_staleness ) { +# return ''; +# } + + my $data = $sector->get_data_for({ +# key_md5 => $self->_apply_digest( $key ), + key => $key, + allow_head => 1, + }); + + # exists() returns 1 or '' for true/false. + return $data ? 1 : ''; } sub delete_key { my $self = shift; my ($obj, $key) = @_; + + my $sector = $self->load_sector( $obj->_base_offset, 'refs' ) + or return ''; + +# if ( $sector->staleness != $obj->_staleness ) { +# return ''; +# } + + return $sector->delete_key({ +# key_md5 => $self->_apply_digest( $key ), + key => $key, + allow_head => 0, + }); } sub write_value { @@ -58,7 +166,10 @@ sub write_value { # Determine if the row was deleted under us # - my ($type); + my $sector = $self->load_sector( $obj->_base_offset, 'refs' ) + or die "Cannot load sector at '@{[$obj->_base_offset]}'\n";; + + my ($type, $class); if ( $r eq 'ARRAY' || $r eq 'HASH' ) { my $tmpvar; if ( $r eq 'ARRAY' ) { @@ -85,19 +196,43 @@ sub write_value { # See whether or not we are storing ourselves to ourself. # Write the sector as data in this reference (keyed by $key) + my $value_sector = $self->load_sector( $tmpvar->_base_offset ); + $sector->write_data({ + key => $key, + key_md5 => $self->_apply_digest( $key ), + value => $value_sector, + }); $value_sector->increment_refcount; return 1; } $type = substr( $r, 0, 1 ); + $class = 'DBM::Deep::Sector::DBI::Reference'; } else { if ( tied($value) ) { DBM::Deep->_throw_error( "Cannot store something that is tied." ); } + + $class = 'DBM::Deep::Sector::DBI::Scalar'; + $type = 'S'; } + # Create this after loading the reference sector in case something bad + # happens. This way, we won't allocate value sector(s) needlessly. + my $value_sector = $class->new({ + engine => $self, + data => $value, + type => $type, + }); + + $sector->write_data({ + key => $key, +# key_md5 => $self->_apply_digest( $key ), + value => $value_sector, + }); + # This code is to make sure we write all the values in the $value to the # disk and to make sure all changes to $value after the assignment are # reflected on disk. This may be counter-intuitive at first, but it is @@ -108,7 +243,7 @@ sub write_value { my @temp = @$value; tie @$value, 'DBM::Deep', { base_offset => $value_sector->offset, - staleness => $value_sector->staleness, +# staleness => $value_sector->staleness, storage => $self->storage, engine => $self, }; @@ -119,7 +254,7 @@ sub write_value { my %temp = %$value; tie %$value, 'DBM::Deep', { base_offset => $value_sector->offset, - staleness => $value_sector->staleness, +# staleness => $value_sector->staleness, storage => $self->storage, engine => $self, }; @@ -131,11 +266,6 @@ sub write_value { return 1; } -sub setup { - my $self = shift; - my ($obj) = @_; -} - sub begin_work { my $self = shift; my ($obj) = @_; diff --git a/lib/DBM/Deep/Engine/File.pm b/lib/DBM/Deep/Engine/File.pm index d5b60f3..d40b51e 100644 --- a/lib/DBM/Deep/Engine/File.pm +++ b/lib/DBM/Deep/Engine/File.pm @@ -20,14 +20,13 @@ my $STALE_SIZE = 2; # Setup file and tag signatures. These should never change. sub SIG_FILE () { 'DPDB' } sub SIG_HEADER () { 'h' } -sub SIG_HASH () { 'H' } -sub SIG_ARRAY () { 'A' } sub SIG_NULL () { 'N' } sub SIG_DATA () { 'D' } sub SIG_INDEX () { 'I' } sub SIG_BLIST () { 'B' } sub SIG_FREE () { 'F' } sub SIG_SIZE () { 1 } +# SIG_HASH and SIG_ARRAY are defined in DBM::Deep::Engine # Please refer to the pack() documentation for further information my %StP = ( @@ -231,6 +230,7 @@ sub make_reference { return; } +# exists returns '', not undefined. sub key_exists { my $self = shift; my ($obj, $key) = @_; diff --git a/lib/DBM/Deep/Sector/DBI.pm b/lib/DBM/Deep/Sector/DBI.pm index 8737207..ed00cbf 100644 --- a/lib/DBM/Deep/Sector/DBI.pm +++ b/lib/DBM/Deep/Sector/DBI.pm @@ -5,7 +5,46 @@ use 5.006_000; use strict; use warnings FATAL => 'all'; -use base 'DBM::Deep::Sector'; +use base qw( DBM::Deep::Sector ); + +use DBM::Deep::Sector::DBI::Reference (); +use DBM::Deep::Sector::DBI::Scalar (); + +sub _init { +} + +sub free { + my $self = shift; + + $self->engine->storage->delete_from( + $self->table, $self->offset, + ); +} + +sub reload { + my $self = shift; + $self->_init; +} + +sub load { + my $self = shift; + my ($engine, $offset, $type) = @_; + + if ( $type eq 'refs' ) { + return DBM::Deep::Sector::DBI::Reference->new({ + engine => $engine, + offset => $offset, + }); + } + elsif ( $type eq 'datas' ) { + return DBM::Deep::Sector::DBI::Scalar->new({ + engine => $engine, + offset => $offset, + }); + } + + DBM::Deep->_throw_error( "'$offset': Don't know what to do with type '$type'" ); +} 1; __END__ diff --git a/lib/DBM/Deep/Sector/DBI/Reference.pm b/lib/DBM/Deep/Sector/DBI/Reference.pm new file mode 100644 index 0000000..e6a0ccc --- /dev/null +++ b/lib/DBM/Deep/Sector/DBI/Reference.pm @@ -0,0 +1,87 @@ +package DBM::Deep::Sector::DBI::Reference; + +use 5.006_000; + +use strict; +use warnings FATAL => 'all'; + +use base 'DBM::Deep::Sector::DBI'; + +sub table { 'refs' } + +sub _init { + my $self = shift; + + my $e = $self->engine; + + unless ( $self->offset ) { + $self->{offset} = $self->engine->storage->write_to( + refs => undef, + ref_type => $self->type, + ); + } + else { + my ($rows) = $self->engine->storage->read_from( + refs => $self->offset, + qw( ref_type ), + ); + + $self->{type} = $rows->[0]{ref_type}; + } + + return; +} + +sub get_data_for { + my $self = shift; + my ($args) = @_; + + my ($rows) = $self->engine->storage->read_from( + datas => { ref_id => $self->offset, key => $args->{key} }, + qw( id ), + ); + + return unless $rows->[0]{id}; + + $self->load( + $self->engine, + $rows->[0]{id}, + 'datas', + ); +} + +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}{data}, + class => $args->{value}{class}, + ); + + $args->{value}->reload; +} + +sub delete_key { + my $self = shift; + my ($args) = @_; + + my $old_value = $self->get_data_for({ + key => $args->{key}, + }); + + my $data; + if ( $old_value ) { + $data = $old_value->data; + $old_value->free; + } + + return $data; +} + +1; +__END__ diff --git a/lib/DBM/Deep/Sector/DBI/Scalar.pm b/lib/DBM/Deep/Sector/DBI/Scalar.pm new file mode 100644 index 0000000..3054602 --- /dev/null +++ b/lib/DBM/Deep/Sector/DBI/Scalar.pm @@ -0,0 +1,56 @@ +package DBM::Deep::Sector::DBI::Scalar; + +use strict; +use warnings FATAL => 'all'; + +use base qw( DBM::Deep::Sector::DBI ); + +sub table { 'datas' } + +sub _init { + my $self = shift; + + my $engine = $self->engine; + unless ( $self->offset ) { +# my ($rows) = $self->engine->storage->write_to( +# datas => undef, +# ( map { $_ => $self->{$_} } qw( ref_id data_type key value class ) ), +# ); + } + else { + my ($rows) = $self->engine->storage->read_from( + datas => $self->offset, + qw( data_type key value class ), + ); + + $self->{$_} = $rows->[0]{$_} for qw( data_type key value class ); + } + + return; +} + +sub data { + my $self = shift; + $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.pm b/lib/DBM/Deep/Sector/File.pm index 21f6273..3be3b22 100644 --- a/lib/DBM/Deep/Sector/File.pm +++ b/lib/DBM/Deep/Sector/File.pm @@ -7,11 +7,11 @@ use warnings FATAL => 'all'; use base qw( DBM::Deep::Sector ); -use DBM::Deep::Sector::File::Reference; -use DBM::Deep::Sector::File::BucketList; -use DBM::Deep::Sector::File::Index; -use DBM::Deep::Sector::File::Null; -use DBM::Deep::Sector::File::Scalar; +use DBM::Deep::Sector::File::BucketList (); +use DBM::Deep::Sector::File::Index (); +use DBM::Deep::Sector::File::Null (); +use DBM::Deep::Sector::File::Reference (); +use DBM::Deep::Sector::File::Scalar (); my $STALE_SIZE = 2; diff --git a/lib/DBM/Deep/Sector/File/Data.pm b/lib/DBM/Deep/Sector/File/Data.pm index fa9b43f..94d3e11 100644 --- a/lib/DBM/Deep/Sector/File/Data.pm +++ b/lib/DBM/Deep/Sector/File/Data.pm @@ -11,14 +11,5 @@ use base qw( DBM::Deep::Sector::File ); sub size { $_[0]{engine}->data_sector_size } sub free_meth { return '_add_free_data_sector' } -sub clone { - my $self = shift; - return ref($self)->new({ - engine => $self->engine, - type => $self->type, - data => $self->data, - }); -} - 1; __END__ diff --git a/lib/DBM/Deep/Sector/File/Reference.pm b/lib/DBM/Deep/Sector/File/Reference.pm index e66a1f5..c2e2271 100644 --- a/lib/DBM/Deep/Sector/File/Reference.pm +++ b/lib/DBM/Deep/Sector/File/Reference.pm @@ -179,8 +179,8 @@ sub delete_key { my @trans_ids = $self->engine->get_running_txn_ids; - # If we're the HEAD and there are running txns, then we need to clone this value to the other - # transactions to preserve Isolation. + # If we're the HEAD and there are running txns, then we need to clone this + # value to the other transactions to preserve Isolation. if ( $self->engine->trans_id == 0 ) { if ( @trans_ids ) { foreach my $other_trans_id ( @trans_ids ) { @@ -200,6 +200,7 @@ sub delete_key { $blist->mark_deleted( $args ); if ( $old_value ) { + #XXX Is this export => 1 actually doing anything? $data = $old_value->data({ export => 1 }); $old_value->free; } diff --git a/lib/DBM/Deep/Sector/File/Scalar.pm b/lib/DBM/Deep/Sector/File/Scalar.pm index 7dfa041..b8a9519 100644 --- a/lib/DBM/Deep/Sector/File/Scalar.pm +++ b/lib/DBM/Deep/Sector/File/Scalar.pm @@ -31,6 +31,15 @@ sub free { return; } +sub clone { + my $self = shift; + return ref($self)->new({ + engine => $self->engine, + type => $self->type, + data => $self->data, + }); +} + sub type { $_[0]{engine}->SIG_DATA } sub _init { my $self = shift; @@ -107,8 +116,6 @@ sub chain_loc { sub data { my $self = shift; -# my ($args) = @_; -# $args ||= {}; my $data; while ( 1 ) { diff --git a/lib/DBM/Deep/Storage/DBI.pm b/lib/DBM/Deep/Storage/DBI.pm index b2c88a6..b86f809 100644 --- a/lib/DBM/Deep/Storage/DBI.pm +++ b/lib/DBM/Deep/Storage/DBI.pm @@ -7,6 +7,59 @@ use warnings FATAL => 'all'; use base 'DBM::Deep::Storage'; +use DBI; + +sub new { + my $class = shift; + my ($args) = @_; + + my $self = bless { + autobless => 1, + dbh => undef, + dbi => undef, + }, $class; + + # Grab the parameters we want to use + foreach my $param ( keys %$self ) { + next unless exists $args->{$param}; + $self->{$param} = $args->{$param}; + } + + $self->open unless $self->{dbh}; + + return $self; +} + +sub open { + my $self = shift; + + # TODO: Is this really what should happen? + return if $self->{dbh}; + + $self->{dbh} = DBI->connect( + $self->{dbi}{dsn}, $self->{dbi}{username}, $self->{dbi}{password}, { + AutoCommit => 0, + PrintError => 0, + RaiseError => 1, + %{ $self->{dbi}{connect_args} || {} }, + }, + ) or die $DBI::error; + + return 1; +} + +sub close { + my $self = shift; + $self->{dbh}->disconnect if $self->{dbh}; + return 1; +} + +sub DESTROY { + my $self = shift; + $self->close if ref $self; +} + +# Is there a portable way of determining writability to a DBH? sub is_writable { my $self = shift; return 1; @@ -24,5 +77,56 @@ sub unlock { my $self = shift; } +sub read_from { + my $self = shift; + my ($table, $cond, @cols) = @_; + + $cond = { id => $cond } unless ref $cond; + + my @keys = keys %$cond; + my $where = join ' AND ', map { "`$_` = ?" } @keys; + + return $self->{dbh}->selectall_arrayref( + "SELECT `@{[join '`,`', @cols ]}` FROM $table WHERE $where", + { Slice => {} }, @{$cond}{@keys}, + ); +} + +sub flush {} + +sub write_to { + my $self = shift; + my ($table, $id, %args) = @_; + + if ( $id ) { + $self->{dbh}->do( + "DELETE FROM $table WHERE id = $id", + ); + } + + my @keys = keys %args; + my $sql = + "INSERT INTO $table ( `id`, " + . join( ',', map { "`$_`" } @keys ) + . ") VALUES (" + . join( ',', ('?') x (@keys + 1) ) + . ")"; + warn $sql. $/; + no warnings; + warn "@args{@keys}\n"; + $self->{dbh}->do( $sql, undef, $id, @args{@keys} ); + + return $self->{dbh}{mysql_insertid}; +} + +sub delete_from { + my $self = shift; + my ($table, $id) = @_; + + $self->{dbh}->do( + "DELETE FROM $table WHERE id = ?", undef, $id, + ); +} + 1; __END__ diff --git a/lib/DBM/Deep/Storage/File.pm b/lib/DBM/Deep/Storage/File.pm index 20c90a3..2b80a5f 100644 --- a/lib/DBM/Deep/Storage/File.pm +++ b/lib/DBM/Deep/Storage/File.pm @@ -76,6 +76,7 @@ There is no return value. =cut +# TODO: What happens if we ->open when we already have a $fh? sub open { my $self = shift; diff --git a/t/02_hash.t b/t/02_hash.t index a317fa3..039e134 100644 --- a/t/02_hash.t +++ b/t/02_hash.t @@ -50,6 +50,7 @@ while ( my $dbm_maker = $dbm_factory->() ) { # # Q: How do we make sure that the iterator is unique? Is it supposed to be? +=pod ## # count keys ## @@ -173,6 +174,7 @@ while ( my $dbm_maker = $dbm_factory->() ) { throws_ok { $db->exists(undef); } qr/Cannot use an undefined hash key/, "EXISTS fails on an undefined key"; +=cut } done_testing;