From: Rob Kinyon <rob.kinyon@gmail.com>
Date: Mon, 30 Nov 2009 02:30:28 +0000 (-0500)
Subject: Created concept of Storage:: in order to start adding more storage backends
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d426259cc2e19971b01c53960085c8b08ff22e2d;p=dbsrgits%2FDBM-Deep.git

Created concept of Storage:: in order to start adding more storage backends
---

diff --git a/MANIFEST b/MANIFEST
index 02e437f..56d1b9d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -12,7 +12,7 @@ lib/DBM/Deep/Engine/Sector/Index.pm
 lib/DBM/Deep/Engine/Sector/Null.pm
 lib/DBM/Deep/Engine/Sector/Reference.pm
 lib/DBM/Deep/Engine/Sector/Scalar.pm
-lib/DBM/Deep/File.pm
+lib/DBM/Deep/Storage/File.pm
 lib/DBM/Deep/Hash.pm
 lib/DBM/Deep/Internals.pod
 lib/DBM/Deep/Iterator.pm
diff --git a/etc/mysql_tables.sql b/etc/mysql_tables.sql
index 7a402a9..f054e5d 100644
--- a/etc/mysql_tables.sql
+++ b/etc/mysql_tables.sql
@@ -1,8 +1,10 @@
+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,
@@ -10,14 +12,16 @@ CREATE TABLE `rec_array_item` (
   `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`),
+  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,
@@ -27,21 +31,24 @@ CREATE TABLE `rec_hash_item` (
   `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`),
+  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,
diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 1d0ea6a..20e9620 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -5,13 +5,11 @@ use 5.006_000;
 use strict;
 use warnings FATAL => 'all';
 
-our $VERSION = q(1.0014);
+our $VERSION = q(1.0015);
 
-use Data::Dumper ();
 use Scalar::Util ();
 
-use DBM::Deep::Engine;
-use DBM::Deep::File;
+use DBM::Deep::Engine ();
 
 use DBM::Deep::SQL::Util;
 use DBM::Deep::SQL::Array;
@@ -23,9 +21,6 @@ use overload
 
 use constant DEBUG => 0;
 
-##
-# Setup constants for users to pass to new()
-##
 sub TYPE_HASH   () { DBM::Deep::Engine->SIG_HASH  }
 sub TYPE_ARRAY  () { DBM::Deep::Engine->SIG_ARRAY }
 
@@ -53,12 +48,10 @@ sub _get_args {
     return $args;
 }
 
+# Class constructor method for Perl OO interface.
+# Calls tie() and returns blessed reference to tied hash or array,
+# providing a hybrid OO/tie interface.
 sub new {
-    ##
-    # Class constructor method for Perl OO interface.
-    # Calls tie() and returns blessed reference to tied hash or array,
-    # providing a hybrid OO/tie interface.
-    ##
     my $class = shift;
     my $args = $class->_get_args( @_ );
     my $self;
@@ -221,13 +214,13 @@ sub _copy_value {
         ${$spot} = $value;
     }
     else {
-        # This assumes hash or array only. This is a bad assumption moving forward.
-        # -RobK, 2008-05-27
         my $r = Scalar::Util::reftype( $value );
         my $tied;
         if ( $r eq 'ARRAY' ) {
             $tied = tied(@$value);
         }
+        # This assumes hash or array only. This is a bad assumption moving
+        # forward. -RobK, 2008-05-27
         else {
             $tied = tied(%$value);
         }
@@ -263,9 +256,6 @@ sub _copy_value {
 #}
 
 sub export {
-    ##
-    # Recursively export into standard Perl hashes and arrays.
-    ##
     my $self = shift->_get_self;
 
     my $temp = $self->_repr;
@@ -298,8 +288,7 @@ sub _check_legality {
 }
 
 sub import {
-    # Perl calls import() on use -- ignore
-    return if !ref $_[0];
+    return if !ref $_[0]; # Perl calls import() on use -- ignore
 
     my $self = shift->_get_self;
     my ($struct) = @_;
@@ -366,13 +355,15 @@ sub import {
 
 #XXX Need to keep track of who has a fh to this file in order to
 #XXX close them all prior to optimize on Win32/cygwin
+# Rebuild entire database into new file, then move
+# it back on top of original.
 sub optimize {
-    ##
-    # Rebuild entire database into new file, then move
-    # it back on top of original.
-    ##
     my $self = shift->_get_self;
 
+    # Optimizing is only something we need to do when we're working with our
+    # own file format. Otherwise, let the other guy do the optimizations.
+#    return unless $self->_engine->isa( 'DBM::Deep::Engine::File' );
+
 #XXX Need to create a new test for this
 #    if ($self->_engine->storage->{links} > 1) {
 #        $self->_throw_error("Cannot optimize: reference count is greater than 1");
@@ -505,10 +496,7 @@ sub commit {
     return $rv;
 }
 
-##
 # Accessor methods
-##
-
 sub _engine {
     my $self = $_[0]->_get_self;
     return $self->{engine};
@@ -529,10 +517,7 @@ sub _staleness {
     return $self->{staleness};
 }
 
-##
 # Utility methods
-##
-
 sub _throw_error {
     my $n = 0;
     while( 1 ) {
@@ -543,10 +528,8 @@ sub _throw_error {
     }
 }
 
+# Store single hash key/value or array element in database.
 sub STORE {
-    ##
-    # Store single hash key/value or array element in database.
-    ##
     my $self = shift->_get_self;
     my ($key, $value) = @_;
     warn "STORE($self, '$key', '@{[defined$value?$value:'undef']}')\n" if DEBUG;
@@ -570,10 +553,8 @@ sub STORE {
     return 1;
 }
 
+# Fetch single value or element given plain key or array index
 sub FETCH {
-    ##
-    # Fetch single value or element given plain key or array index
-    ##
     my $self = shift->_get_self;
     my ($key) = @_;
     warn "FETCH($self, '$key')\n" if DEBUG;
@@ -591,10 +572,8 @@ sub FETCH {
         : $result;
 }
 
+# Delete single key/value pair or element given plain key or array index
 sub DELETE {
-    ##
-    # Delete single key/value pair or element given plain key or array index
-    ##
     my $self = shift->_get_self;
     my ($key) = @_;
     warn "DELETE($self, '$key')\n" if DEBUG;
@@ -619,10 +598,8 @@ sub DELETE {
     return $value;
 }
 
+# Check if a single key or element exists given plain key or array index
 sub EXISTS {
-    ##
-    # Check if a single key or element exists given plain key or array index
-    ##
     my $self = shift->_get_self;
     my ($key) = @_;
     warn "EXISTS($self, '$key')\n" if DEBUG;
@@ -636,10 +613,8 @@ sub EXISTS {
     return $result;
 }
 
+# Clear all keys from hash, or all elements from array.
 sub CLEAR {
-    ##
-    # Clear all keys from hash, or all elements from array.
-    ##
     my $self = shift->_get_self;
     warn "CLEAR($self)\n" if DEBUG;
 
@@ -674,16 +649,14 @@ sub CLEAR {
     return 1;
 }
 
-##
 # Public method aliases
-##
-sub put { (shift)->STORE( @_ ) }
-sub store { (shift)->STORE( @_ ) }
-sub get { (shift)->FETCH( @_ ) }
-sub fetch { (shift)->FETCH( @_ ) }
+sub put    { (shift)->STORE( @_ )  }
+sub get    { (shift)->FETCH( @_ )  }
+sub store  { (shift)->STORE( @_ )  }
+sub fetch  { (shift)->FETCH( @_ )  }
 sub delete { (shift)->DELETE( @_ ) }
 sub exists { (shift)->EXISTS( @_ ) }
-sub clear { (shift)->CLEAR( @_ ) }
+sub clear  { (shift)->CLEAR( @_ )  }
 
 sub _dump_file {shift->_get_self->_engine->_dump_file;}
 
diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 5521477..b4a4636 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -3,9 +3,7 @@ package DBM::Deep::Array;
 use 5.006_000;
 
 use strict;
-use warnings;
-
-our $VERSION = q(1.0013);
+use warnings FATAL => 'all';
 
 # This is to allow DBM::Deep::Array to handle negative indices on
 # its own. Otherwise, Perl would intercept the call to negative
@@ -171,9 +169,9 @@ sub DELETE {
     return $rv;
 }
 
-# Now that we have a real Reference sector, we should store arrayzize there. However,
-# arraysize needs to be transactionally-aware, so a simple location to store it isn't
-# going to work.
+# Now that we have a real Reference sector, we should store arrayzize there.
+# However, arraysize needs to be transactionally-aware, so a simple location to
+# store it isn't going to work.
 sub FETCHSIZE {
     my $self = shift->_get_self;
 
@@ -378,12 +376,9 @@ sub SPLICE {
 
 # We don't need to populate it, yet.
 # It will be useful, though, when we split out HASH and ARRAY
-sub EXTEND {
-    ##
-    # Perl will call EXTEND() when the array is likely to grow.
-    # We don't care, but include it because it gets called at times.
-    ##
-}
+# Perl will call EXTEND() when the array is likely to grow.
+# We don't care, but include it because it gets called at times.
+sub EXTEND {}
 
 sub _copy_node {
     my $self = shift;
@@ -397,14 +392,11 @@ sub _copy_node {
     return 1;
 }
 
-##
-# Public method aliases
-##
-sub length { (shift)->FETCHSIZE(@_) }
-sub pop { (shift)->POP(@_) }
-sub push { (shift)->PUSH(@_) }
-sub unshift { (shift)->UNSHIFT(@_) }
-sub splice { (shift)->SPLICE(@_) }
+sub length  { (shift)->FETCHSIZE(@_) }
+sub pop     { (shift)->POP(@_)       }
+sub push    { (shift)->PUSH(@_)      }
+sub unshift { (shift)->UNSHIFT(@_)   }
+sub splice  { (shift)->SPLICE(@_)    }
 
 # This must be last otherwise we have to qualify all other calls to shift
 # as calls to CORE::shift
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 49a075c..873d1b2 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -29,6 +29,7 @@ sub SIG_BLIST    () { 'B'    }
 sub SIG_FREE     () { 'F'    }
 sub SIG_SIZE     () {  1     }
 
+use DBM::Deep::Storage::File ();
 use DBM::Deep::Iterator ();
 use DBM::Deep::Engine::Sector::Data ();
 use DBM::Deep::Engine::Sector::BucketList ();
@@ -152,7 +153,7 @@ sub new {
     my $class = shift;
     my ($args) = @_;
 
-    $args->{storage} = DBM::Deep::File->new( $args )
+    $args->{storage} = DBM::Deep::Storage::File->new( $args )
         unless exists $args->{storage};
 
     my $self = bless {
diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 50dd19d..dafbe2f 100644
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -14,9 +14,6 @@ sub _get_self {
 sub _repr { return {} }
 
 sub TIEHASH {
-    ##
-    # Tied hash constructor method, called by Perl's tie() function.
-    ##
     my $class = shift;
     my $args = $class->_get_args( @_ );
     
@@ -66,10 +63,8 @@ sub DELETE {
     return $self->SUPER::DELETE( $key, $_[0] );
 }
 
+# Locate and return first key (in no particular order)
 sub FIRSTKEY {
-    ##
-    # Locate and return first key (in no particular order)
-    ##
     my $self = shift->_get_self;
 
     $self->lock_shared;
@@ -83,10 +78,8 @@ sub FIRSTKEY {
         : $result;
 }
 
+# Return next key (in no particular order), given previous one
 sub NEXTKEY {
-    ##
-    # Return next key (in no particular order), given previous one
-    ##
     my $self = shift->_get_self;
 
     my $prev_key = ($self->_engine->storage->{filter_store_key})
@@ -104,11 +97,8 @@ sub NEXTKEY {
         : $result;
 }
 
-##
-# Public method aliases
-##
 sub first_key { (shift)->FIRSTKEY(@_) }
-sub next_key { (shift)->NEXTKEY(@_) }
+sub next_key  { (shift)->NEXTKEY(@_)  }
 
 sub _copy_node {
     my $self = shift;
diff --git a/lib/DBM/Deep/Iterator.pm b/lib/DBM/Deep/Iterator.pm
index 8ff9014..4fd10e3 100644
--- a/lib/DBM/Deep/Iterator.pm
+++ b/lib/DBM/Deep/Iterator.pm
@@ -111,7 +111,7 @@ sub get_next_key {
     unless ( @$crumbs ) {
         # This will be a Reference sector
         my $sector = $e->_load_sector( $self->{base_offset} )
-            # If no sector is found, thist must have been deleted from under us.
+            # If no sector is found, this must have been deleted from under us.
             or return;
 
         if ( $sector->staleness != $obj->_staleness ) {
diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/Storage/File.pm
similarity index 93%
rename from lib/DBM/Deep/File.pm
rename to lib/DBM/Deep/Storage/File.pm
index ba4d04f..96862d3 100644
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/Storage/File.pm
@@ -1,4 +1,4 @@
-package DBM::Deep::File;
+package DBM::Deep::Storage::File;
 
 use 5.006_000;
 
@@ -11,7 +11,7 @@ use constant DEBUG => 0;
 
 =head1 NAME
 
-DBM::Deep::File
+DBM::Deep::Storage::File
 
 =head1 PURPOSE
 
@@ -22,8 +22,8 @@ Currently, the only storage mechanism supported is the file system.
 
 =head1 OVERVIEW
 
-This class provides an abstraction to the storage mechanism so that the Engine (the
-only class that uses this class) doesn't have to worry about that.
+This class provides an abstraction to the storage mechanism so that the Engine
+(the only class that uses this class) doesn't have to worry about that.
 
 =head1 METHODS
 
@@ -142,8 +142,8 @@ sub size {
 
 This will set the inode value of the underlying file object.
 
-This is only needed to handle some obscure Win32 bugs. It reqlly shouldn't be needed outside
-this object.
+This is only needed to handle some obscure Win32 bugs. It reqlly shouldn't be
+needed outside this object.
 
 There is no return value.
 
@@ -165,9 +165,9 @@ sub set_inode {
 
 This takes an optional offset and some data to print.
 
-C< $offset >, if defined, will be used to seek into the file. If file_offset is set, it will be used
-as the zero location. If it is undefined, no seeking will occur. Then, C< @data > will be printed to
-the current location.
+C< $offset >, if defined, will be used to seek into the file. If file_offset is
+set, it will be used as the zero location. If it is undefined, no seeking will
+occur. Then, C< @data > will be printed to the current location.
 
 There is no return value.
 
@@ -199,9 +199,9 @@ sub print_at {
 
 This takes an optional offset and a length.
 
-C< $offset >, if defined, will be used to seek into the file. If file_offset is set, it will be used
-as the zero location. If it is undefined, no seeking will occur. Then, C< $length > bytes will be
-read from the current location.
+C< $offset >, if defined, will be used to seek into the file. If file_offset is
+set, it will be used as the zero location. If it is undefined, no seeking will
+occur. Then, C< $length > bytes will be read from the current location.
 
 The data read will be returned.
 
@@ -231,7 +231,7 @@ sub read_at {
 
 =head2 DESTROY
 
-When the ::File object goes out of scope, it will be closed.
+When the ::Storage::File object goes out of scope, it will be closed.
 
 =cut
 
diff --git a/t/11_optimize.t b/t/11_optimize.t
index fbb7975..09b7d19 100644
--- a/t/11_optimize.t
+++ b/t/11_optimize.t
@@ -51,7 +51,7 @@ my $result = $db->optimize();
 my $after = (stat($filename))[7];
 
 ok( $result, "optimize succeeded" );
-ok( $after < $before, "file size has shrunk" ); # make sure file shrunk
+cmp_ok( $after, '<', $before, "file size has shrunk" ); # make sure file shrunk
 
 is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
 is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
diff --git a/t/common.pm b/t/common.pm
index c0a881f..1d47d04 100644
--- a/t/common.pm
+++ b/t/common.pm
@@ -1,12 +1,8 @@
 package # Hide from PAUSE
     t::common;
 
-use 5.006_000;
-
 use strict;
-use warnings;
-
-our $VERSION = '0.01';
+use warnings FATAL => 'all';
 
 use base 'Exporter';
 our @EXPORT_OK = qw(
@@ -20,7 +16,6 @@ use Fcntl qw( :flock );
 
 my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir;
 my $dir = tempdir( CLEANUP => 1, DIR => $parent );
-#my $dir = tempdir( DIR => '.' );
 
 sub new_fh {
     my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir, UNLINK => 1 );
@@ -37,6 +32,23 @@ sub new_dbm {
     my @extra_args = (
         [ file => $filename ],
     );
+
+#    eval { require DBD::SQLite; };
+#    unless ( $@ ) {
+#        push @extra_args, [
+#        ];
+#    }
+
+    if ( $ENV{TEST_MYSQL_DSN} ) {
+        push @extra_args, [
+            dbi => {
+                dsn      => "dbi:mysql:$ENV{TEST_MYSQL_DSN}",
+                user     => $ENV{TEST_MYSQL_USER},
+                password => $ENV{TEST_MYSQL_PASS},
+            },
+        ];
+    }
+
     return sub {
         return unless @extra_args;
         my @these_args = @{ shift @extra_args };