From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Mon, 10 Apr 2006 03:33:15 +0000 (+0000)
Subject: Broke _root out into its own object, moved a few methods up to it, and renamed _root... 
X-Git-Tag: 0-99_01~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=460b106703a60d35609f3673ceb5fa39173fdef2;p=dbsrgits%2FDBM-Deep.git

Broke _root out into its own object, moved a few methods up to it, and renamed _root to _fileobj
---

diff --git a/MANIFEST b/MANIFEST
index 23929d1..f7c6f68 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6,6 +6,7 @@ MANIFEST
 META.yml
 lib/DBM/Deep.pm
 lib/DBM/Deep/Engine.pm
+lib/DBM/Deep/File.pm
 lib/DBM/Deep/Array.pm
 lib/DBM/Deep/Hash.pm
 t/01_basic.t
diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 98d5df9..082ba87 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -29,13 +29,17 @@ package DBM::Deep;
 #    modify it under the same terms as Perl itself.
 ##
 
+use 5.6.0;
+
 use strict;
+use warnings;
 
 use Fcntl qw( :DEFAULT :flock :seek );
 use Digest::MD5 ();
 use Scalar::Util ();
 
 use DBM::Deep::Engine;
+use DBM::Deep::File;
 
 use vars qw( $VERSION );
 $VERSION = q(0.99_01);
@@ -102,11 +106,18 @@ sub _init {
     my $class = shift;
     my ($args) = @_;
 
+    $args->{fileobj} = DBM::Deep::File->new( $args )
+        unless exists $args->{fileobj};
+
+    # locking implicitly enables autoflush
+    if ($args->{locking}) { $args->{autoflush} = 1; }
+
     # These are the defaults to be optionally overridden below
     my $self = bless {
         type        => TYPE_HASH,
         engine      => DBM::Deep::Engine->new( $args ),
         base_offset => undef,
+        fileobj     => undef,
     }, $class;
 
     # Grab the parameters we want to use
@@ -115,13 +126,6 @@ sub _init {
         $self->{$param} = $args->{$param};
     }
 
-    # locking implicitly enables autoflush
-    if ($args->{locking}) { $args->{autoflush} = 1; }
-
-    $self->{root} = exists $args->{root}
-        ? $args->{root}
-        : DBM::Deep::_::Root->new( $args );
-
     $self->{engine}->setup_fh( $self );
 
     return $self;
@@ -155,26 +159,27 @@ sub lock {
 
     if (!defined($self->_fh)) { return; }
 
-    if ($self->_root->{locking}) {
-        if (!$self->_root->{locked}) {
+    if ($self->_fileobj->{locking}) {
+        if (!$self->_fileobj->{locked}) {
             flock($self->_fh, $type);
 
             # refresh end counter in case file has changed size
             my @stats = stat($self->_fh);
-            $self->_root->{end} = $stats[7];
+            $self->_fileobj->{end} = $stats[7];
 
             # double-check file inode, in case another process
             # has optimize()d our file while we were waiting.
-            if ($stats[1] != $self->_root->{inode}) {
-                $self->{engine}->close_fh( $self );
+            if ($stats[1] != $self->_fileobj->{inode}) {
+                $self->_fileobj->close;
+                $self->_fileobj->open;
                 $self->{engine}->setup_fh( $self );
                 flock($self->_fh, $type); # re-lock
 
                 # This may not be necessary after re-opening
-                $self->_root->{end} = (stat($self->_fh))[7]; # re-end
+                $self->_fileobj->{end} = (stat($self->_fh))[7]; # re-end
             }
         }
-        $self->_root->{locked}++;
+        $self->_fileobj->{locked}++;
 
         return 1;
     }
@@ -191,9 +196,9 @@ sub unlock {
 
     if (!defined($self->_fh)) { return; }
 
-    if ($self->_root->{locking} && $self->_root->{locked} > 0) {
-        $self->_root->{locked}--;
-        if (!$self->_root->{locked}) { flock($self->_fh, LOCK_UN); }
+    if ($self->_fileobj->{locking} && $self->_fileobj->{locked} > 0) {
+        $self->_fileobj->{locked}--;
+        if (!$self->_fileobj->{locked}) { flock($self->_fh, LOCK_UN); }
 
         return 1;
     }
@@ -276,12 +281,12 @@ sub optimize {
     my $self = shift->_get_self;
 
 #XXX Need to create a new test for this
-#    if ($self->_root->{links} > 1) {
+#    if ($self->_fileobj->{links} > 1) {
 #        $self->_throw_error("Cannot optimize: reference count is greater than 1");
 #    }
 
     my $db_temp = DBM::Deep->new(
-        file => $self->_root->{file} . '.tmp',
+        file => $self->_fileobj->{file} . '.tmp',
         type => $self->_type
     );
 
@@ -296,8 +301,8 @@ sub optimize {
     my $perms = $stats[2] & 07777;
     my $uid = $stats[4];
     my $gid = $stats[5];
-    chown( $uid, $gid, $self->_root->{file} . '.tmp' );
-    chmod( $perms, $self->_root->{file} . '.tmp' );
+    chown( $uid, $gid, $self->_fileobj->{file} . '.tmp' );
+    chmod( $perms, $self->_fileobj->{file} . '.tmp' );
 
     # q.v. perlport for more information on this variable
     if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
@@ -308,17 +313,18 @@ sub optimize {
         # with a soft copy.
         ##
         $self->unlock();
-        $self->{engine}->close_fh( $self );
+        $self->_fileobj->close;
     }
 
-    if (!rename $self->_root->{file} . '.tmp', $self->_root->{file}) {
-        unlink $self->_root->{file} . '.tmp';
+    if (!rename $self->_fileobj->{file} . '.tmp', $self->_fileobj->{file}) {
+        unlink $self->_fileobj->{file} . '.tmp';
         $self->unlock();
         $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
     }
 
     $self->unlock();
-    $self->{engine}->close_fh( $self );
+    $self->_fileobj->close;
+    $self->_fileobj->open;
     $self->{engine}->setup_fh( $self );
 
     return 1;
@@ -333,7 +339,7 @@ sub clone {
     return DBM::Deep->new(
         type => $self->_type,
         base_offset => $self->_base_offset,
-        root => $self->_root
+        fileobj => $self->_fileobj,
     );
 }
 
@@ -354,7 +360,7 @@ sub clone {
         my $func = shift;
 
         if ( $is_legal_filter{$type} ) {
-            $self->_root->{"filter_$type"} = $func;
+            $self->_fileobj->{"filter_$type"} = $func;
             return 1;
         }
 
@@ -378,12 +384,12 @@ sub rollback {
 # Accessor methods
 ##
 
-sub _root {
+sub _fileobj {
     ##
     # Get access to the root structure
     ##
     my $self = $_[0]->_get_self;
-    return $self->{root};
+    return $self->{fileobj};
 }
 
 sub _type {
@@ -407,7 +413,7 @@ sub _fh {
     # Get access to the raw fh
     ##
     my $self = $_[0]->_get_self;
-    return $self->_root->{fh};
+    return $self->_fileobj->{fh};
 }
 
 ##
@@ -450,8 +456,8 @@ sub STORE {
 
     # User may be storing a hash, in which case we do not want it run
     # through the filtering system
-    if ( !ref($value) && $self->_root->{filter_store_value} ) {
-        $value = $self->_root->{filter_store_value}->( $value );
+    if ( !ref($value) && $self->_fileobj->{filter_store_value} ) {
+        $value = $self->_fileobj->{filter_store_value}->( $value );
     }
 
     ##
@@ -493,8 +499,8 @@ sub FETCH {
 
     # Filters only apply to scalar values, so the ref check is making
     # sure the fetched bucket is a scalar, not a child hash or array.
-    return ($result && !ref($result) && $self->_root->{filter_fetch_value})
-        ? $self->_root->{filter_fetch_value}->($result)
+    return ($result && !ref($result) && $self->_fileobj->{filter_fetch_value})
+        ? $self->_fileobj->{filter_fetch_value}->($result)
         : $result;
 }
 
@@ -527,8 +533,8 @@ sub DELETE {
     ##
     my $value = $self->{engine}->get_bucket_value($self,  $tag, $md5 );
 
-    if (defined $value && !ref($value) && $self->_root->{filter_fetch_value}) {
-        $value = $self->_root->{filter_fetch_value}->($value);
+    if (defined $value && !ref($value) && $self->_fileobj->{filter_fetch_value}) {
+        $value = $self->_fileobj->{filter_fetch_value}->($value);
     }
 
     my $result = $self->{engine}->delete_bucket( $self, $tag, $md5 );
@@ -594,7 +600,7 @@ sub CLEAR {
 
     my $fh = $self->_fh;
 
-    seek($fh, $self->_base_offset + $self->_root->{file_offset}, SEEK_SET);
+    seek($fh, $self->_base_offset + $self->_fileobj->{file_offset}, SEEK_SET);
     if (eof $fh) {
         $self->unlock();
         return;
@@ -622,49 +628,6 @@ sub delete { (shift)->DELETE( @_ ) }
 sub exists { (shift)->EXISTS( @_ ) }
 sub clear { (shift)->CLEAR( @_ ) }
 
-package DBM::Deep::_::Root;
-
-sub new {
-    my $class = shift;
-    my ($args) = @_;
-
-    my $self = bless {
-        autobless          => undef,
-        autoflush          => undef,
-        end                => 0,
-        fh                 => undef,
-        file               => undef,
-        file_offset        => 0,
-        locking            => undef,
-        locked             => 0,
-        filter_store_key   => undef,
-        filter_store_value => undef,
-        filter_fetch_key   => undef,
-        filter_fetch_value => undef,
-    }, $class;
-
-    # Grab the parameters we want to use
-    foreach my $param ( keys %$self ) {
-        next unless exists $args->{$param};
-        $self->{$param} = $args->{$param};
-    }
-
-    if ( $self->{fh} && !$self->{file_offset} ) {
-        $self->{file_offset} = tell( $self->{fh} );
-    }
-
-    return $self;
-}
-
-sub DESTROY {
-    my $self = shift;
-    return unless $self;
-
-    close $self->{fh} if $self->{fh};
-
-    return;
-}
-
 1;
 __END__
 
@@ -1420,10 +1383,10 @@ you can call the C<_fh()> method, which returns the handle:
 This method can be called on the root level of the datbase, or any child
 hashes or arrays.  All levels share a I<root> structure, which contains things
 like the filehandle, a reference counter, and all the options specified
-when you created the object.  You can get access to this root structure by
-calling the C<root()> method.
+when you created the object.  You can get access to this file object by
+calling the C<_fileobj()> method.
 
-    my $root = $db->_root();
+    my $file_obj = $db->_fileobj();
 
 This is useful for changing options after the object has already been created,
 such as enabling/disabling locking.  You can also store your own temporary user
diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index f1b0406..d95fed8 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -1,12 +1,14 @@
 package DBM::Deep::Array;
 
+use 5.6.0;
+
 use strict;
+use warnings;
 
 # This is to allow DBM::Deep::Array to handle negative indices on
 # its own. Otherwise, Perl would intercept the call to negative
 # indices for us. This was causing bugs for negative index handling.
-use vars qw( $NEGATIVE_INDICES );
-$NEGATIVE_INDICES = 1;
+our $NEGATIVE_INDICES = 1;
 
 use base 'DBM::Deep';
 
@@ -32,9 +34,6 @@ sub _import {
     return 1;
 }
 sub TIEARRAY {
-##
-# Tied array constructor method, called by Perl's tie() function.
-##
     my $class = shift;
     my $args = $class->_get_args( @_ );
 	
@@ -163,19 +162,16 @@ sub DELETE {
 }
 
 sub FETCHSIZE {
-	##
-	# Return the length of the array
-	##
     my $self = shift->_get_self;
 
     $self->lock( $self->LOCK_SH );
 
-	my $SAVE_FILTER = $self->_root->{filter_fetch_value};
-	$self->_root->{filter_fetch_value} = undef;
+	my $SAVE_FILTER = $self->_fileobj->{filter_fetch_value};
+	$self->_fileobj->{filter_fetch_value} = undef;
 	
 	my $packed_size = $self->FETCH('length');
 	
-	$self->_root->{filter_fetch_value} = $SAVE_FILTER;
+	$self->_fileobj->{filter_fetch_value} = $SAVE_FILTER;
 	
     $self->unlock;
 
@@ -187,20 +183,17 @@ sub FETCHSIZE {
 }
 
 sub STORESIZE {
-	##
-	# Set the length of the array
-	##
     my $self = shift->_get_self;
 	my ($new_length) = @_;
 	
     $self->lock( $self->LOCK_EX );
 
-	my $SAVE_FILTER = $self->_root->{filter_store_value};
-	$self->_root->{filter_store_value} = undef;
+	my $SAVE_FILTER = $self->_fileobj->{filter_store_value};
+	$self->_fileobj->{filter_store_value} = undef;
 	
 	my $result = $self->STORE('length', pack($self->{engine}{long_pack}, $new_length));
 	
-	$self->_root->{filter_store_value} = $SAVE_FILTER;
+	$self->_fileobj->{filter_store_value} = $SAVE_FILTER;
 	
     $self->unlock;
 
@@ -208,9 +201,6 @@ sub STORESIZE {
 }
 
 sub POP {
-	##
-	# Remove and return the last element on the array
-	##
     my $self = shift->_get_self;
 
     $self->lock( $self->LOCK_EX );
@@ -232,9 +222,6 @@ sub POP {
 }
 
 sub PUSH {
-	##
-	# Add new element(s) to the end of the array
-	##
     my $self = shift->_get_self;
 	
     $self->lock( $self->LOCK_EX );
@@ -252,10 +239,6 @@ sub PUSH {
 }
 
 sub SHIFT {
-	##
-	# Remove and return first element on the array.
-	# Shift over remaining elements to take up space.
-	##
     my $self = shift->_get_self;
 
     $self->lock( $self->LOCK_EX );
@@ -265,9 +248,6 @@ sub SHIFT {
 	if ($length) {
 		my $content = $self->FETCH( 0 );
 		
-		##
-		# Shift elements over and remove last one.
-		##
 		for (my $i = 0; $i < $length - 1; $i++) {
 			$self->STORE( $i, $self->FETCH($i + 1) );
 		}
@@ -284,10 +264,6 @@ sub SHIFT {
 }
 
 sub UNSHIFT {
-	##
-	# Insert new element(s) at beginning of array.
-	# Shift over other elements to make space.
-	##
     my $self = shift->_get_self;
 	my @new_elements = @_;
 
@@ -312,10 +288,6 @@ sub UNSHIFT {
 }
 
 sub SPLICE {
-	##
-	# Splices section of array with optional new section.
-	# Returns deleted section, or last element deleted in scalar context.
-	##
     my $self = shift->_get_self;
 
     $self->lock( $self->LOCK_EX );
@@ -379,12 +351,12 @@ sub SPLICE {
 	return wantarray ? @old_elements : $old_elements[-1];
 }
 
-#XXX We don't need to define it, yet.
-#XXX It will be useful, though, when we split out HASH and ARRAY
+# We don't need to define 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 for compatibility.
+	# We don't care, but include it because it gets called at times.
 	##
 }
 
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index ba9185e..547a7af 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -1,6 +1,9 @@
 package DBM::Deep::Engine;
 
+use 5.6.0;
+
 use strict;
+use warnings;
 
 use Fcntl qw( :DEFAULT :flock :seek );
 
@@ -8,6 +11,7 @@ use Fcntl qw( :DEFAULT :flock :seek );
 # Setup file and tag signatures.  These should never change.
 ##
 sub SIG_FILE     () { 'DPDB' }
+sub SIG_HEADER   () { 'h'    }
 sub SIG_INTERNAL () { 'i'    }
 sub SIG_HASH     () { 'H'    }
 sub SIG_ARRAY    () { 'A'    }
@@ -38,6 +42,8 @@ sub new {
         # reindex overrun.
         ##
         max_buckets => 16,
+
+        fileobj => undef,
     }, $class;
 
     if ( defined $args->{pack_size} ) {
@@ -72,6 +78,9 @@ sub new {
     return $self;
 }
 
+sub _fileobj { return $_[0]{fileobj} }
+sub _fh      { return $_[0]->_fileobj->{fh} }
+
 sub calculate_sizes {
     my $self = shift;
 
@@ -84,17 +93,20 @@ sub calculate_sizes {
 
 sub write_file_header {
     my $self = shift;
-    my ($obj) = @_;
+#    my ($obj) = @_;
 
-    my $fh = $obj->_fh;
+    my $fh = $self->_fh;
 
     my $loc = $self->_request_space(
-        $obj, length( SIG_FILE ) + 12,
+        undef, length( SIG_FILE ) + 21,
     );
-    seek($fh, $loc + $obj->_root->{file_offset}, SEEK_SET);
+    seek($fh, $loc + $self->_fileobj->{file_offset}, SEEK_SET);
     print( $fh
         SIG_FILE,
-        pack('S', 1),
+        SIG_HEADER,
+        pack('N', 1),  # header version
+        pack('N', 12), # header size
+        pack('N', 0),  # file version
         pack('S', $self->{long_size}),
         pack('A', $self->{long_pack}),
         pack('S', $self->{data_size}),
@@ -111,35 +123,71 @@ sub read_file_header {
 
     my $fh = $obj->_fh;
 
-    seek($fh, 0 + $obj->_root->{file_offset}, SEEK_SET);
+    seek($fh, 0 + $obj->_fileobj->{file_offset}, SEEK_SET);
     my $buffer;
-    my $bytes_read = read(
-        $fh, $buffer, length(SIG_FILE) + 12,
+    my $bytes_read = read( $fh, $buffer, length(SIG_FILE) + 9 );
+
+    return unless $bytes_read;
+
+    my ($file_signature, $sig_header, $header_version, $size) = unpack(
+        'A4 A N N', $buffer
     );
 
-    if ( $bytes_read ) {
-        my ($signature, $version, @values) = unpack( 'A4 S S A S A S', $buffer );
-        unless ($signature eq SIG_FILE) {
-            $self->close_fh( $obj );
-            $obj->_throw_error("Signature not found -- file is not a Deep DB");
-        }
+    unless ( $file_signature eq SIG_FILE ) {
+        $self->{fileobj}->close;
+        $obj->_throw_error( "Signature not found -- file is not a Deep DB" );
+    }
 
-        if ( @values < 5 || grep { !defined } @values ) {
-            die "DBM::Deep: Corrupted file - bad header\n";
-        }
+    unless ( $sig_header eq SIG_HEADER ) {
+        $self->{fileobj}->close;
+        $obj->_throw_error( "Old file version found." );
+    }
 
-        #XXX Add warnings if values weren't set right
-        @{$self}{qw( long_size long_pack data_size data_pack max_buckets )} = @values;
+    my $buffer2;
+    $bytes_read += read( $fh, $buffer2, $size );
+    my ($file_version, @values) = unpack( 'N S A S A S', $buffer2 );
+    if ( @values < 5 || grep { !defined } @values ) {
+        $self->{fileobj}->close;
+        $obj->_throw_error("Corrupted file - bad header");
     }
 
+    #XXX Add warnings if values weren't set right
+    @{$self}{qw(long_size long_pack data_size data_pack max_buckets)} = @values;
+
     return $bytes_read;
 }
 
-sub setup_fh {
+sub get_file_version {
     my $self = shift;
     my ($obj) = @_;
 
-    $self->open( $obj ) if !defined $obj->_fh;
+    my $fh = $obj->_fh;
+
+    seek( $fh, 13 + $obj->_fileobj->{file_offset}, SEEK_SET );
+    my $buffer;
+    my $bytes_read = read( $fh, $buffer, 4 );
+    unless ( $bytes_read == 4 ) {
+        $obj->_throw_error( "Cannot read file version" );
+    }
+
+    return unpack( 'N', $buffer );
+}
+
+sub write_file_version {
+    my $self = shift;
+    my ($obj, $new_version) = @_;
+
+    my $fh = $obj->_fh;
+
+    seek( $fh, 13 + $obj->_fileobj->{file_offset}, SEEK_SET );
+    print( $fh pack( 'N', $new_version ) );
+
+    return;
+}
+
+sub setup_fh {
+    my $self = shift;
+    my ($obj) = @_;
 
     my $fh = $obj->_fh;
     flock $fh, LOCK_EX;
@@ -189,10 +237,10 @@ sub setup_fh {
     }
 
     #XXX We have to make sure we don't mess up when autoflush isn't turned on
-    unless ( $obj->_root->{inode} ) {
+    unless ( $obj->_fileobj->{inode} ) {
         my @stats = stat($obj->_fh);
-        $obj->_root->{inode} = $stats[1];
-        $obj->_root->{end} = $stats[7];
+        $obj->_fileobj->{inode} = $stats[1];
+        $obj->_fileobj->{end} = $stats[7];
     }
 
     flock $fh, LOCK_UN;
@@ -200,48 +248,6 @@ sub setup_fh {
     return 1;
 }
 
-sub open {
-    ##
-    # Open a fh to the database, create if nonexistent.
-    # Make sure file signature matches DBM::Deep spec.
-    ##
-    my $self = shift;
-    my ($obj) = @_;
-
-    # Theoretically, adding O_BINARY should remove the need for the binmode
-    # Of course, testing it is going to be ... interesting.
-    my $flags = O_RDWR | O_CREAT | O_BINARY;
-
-    my $fh;
-    my $filename = $obj->_root->{file};
-    sysopen( $fh, $filename, $flags )
-        or $obj->_throw_error("Cannot sysopen file '$filename': $!");
-    $obj->_root->{fh} = $fh;
-
-    # Even though we use O_BINARY, better be safe than sorry.
-    binmode $fh;
-
-    if ($obj->_root->{autoflush}) {
-        my $old = select $fh;
-        $|=1;
-        select $old;
-    }
-
-    return 1;
-}
-
-sub close_fh {
-    my $self = shift;
-    my ($obj) = @_;
-
-    if ( my $fh = $obj->_root->{fh} ) {
-        close $fh;
-    }
-    $obj->_root->{fh} = undef;
-
-    return 1;
-}
-
 sub tag_size {
     my $self = shift;
     my ($size) = @_;
@@ -259,7 +265,7 @@ sub write_tag {
     my $fh = $obj->_fh;
 
     if ( defined $offset ) {
-        seek($fh, $offset + $obj->_root->{file_offset}, SEEK_SET);
+        seek($fh, $offset + $obj->_fileobj->{file_offset}, SEEK_SET);
     }
 
     print( $fh $sig . pack($self->{data_pack}, $size) . $content );
@@ -285,7 +291,7 @@ sub load_tag {
 
     my $fh = $obj->_fh;
 
-    seek($fh, $offset + $obj->_root->{file_offset}, SEEK_SET);
+    seek($fh, $offset + $obj->_fileobj->{file_offset}, SEEK_SET);
 
     #XXX I'm not sure this check will work if autoflush isn't enabled ...
     return if eof $fh;
@@ -356,12 +362,12 @@ sub _length_needed {
     my $len = SIG_SIZE + $self->{data_size}
             + $self->{data_size} + length( $key );
 
-    if ( $is_dbm_deep && $value->_root eq $obj->_root ) {
+    if ( $is_dbm_deep && $value->_fileobj eq $obj->_fileobj ) {
         return $len + $self->{long_size};
     }
 
     my $r = Scalar::Util::reftype( $value ) || '';
-    if ( $obj->_root->{autobless} ) {
+    if ( $obj->_fileobj->{autobless} ) {
         # This is for the bit saying whether or not this thing is blessed.
         $len += 1;
     }
@@ -377,7 +383,7 @@ sub _length_needed {
 
     # if autobless is enabled, must also take into consideration
     # the class name as it is stored after the key.
-    if ( $obj->_root->{autobless} ) {
+    if ( $obj->_fileobj->{autobless} ) {
         my $c = Scalar::Util::blessed($value);
         if ( defined $c && !$is_dbm_deep ) {
             $len += $self->{data_size} + length($c);
@@ -411,7 +417,7 @@ sub add_bucket {
     my $location = 0;
     my $result = 2;
 
-    my $root = $obj->_root;
+    my $root = $obj->_fileobj;
     my $fh   = $obj->_fh;
 
     my $actual_length = $self->_length_needed( $obj, $value, $plain_key );
@@ -463,10 +469,10 @@ sub write_value {
     my ($obj, $location, $key, $value) = @_;
 
     my $fh = $obj->_fh;
-    my $root = $obj->_root;
+    my $root = $obj->_fileobj;
 
     my $dbm_deep_obj = _get_dbm_object( $value );
-    if ( $dbm_deep_obj && $dbm_deep_obj->_root ne $obj->_root ) {
+    if ( $dbm_deep_obj && $dbm_deep_obj->_fileobj ne $obj->_fileobj ) {
         $obj->_throw_error( "Cannot cross-reference. Use export() instead" );
     }
 
@@ -533,7 +539,7 @@ sub write_value {
         my %x = %$value;
         tie %$value, 'DBM::Deep', {
             base_offset => $location,
-            root => $root,
+            fileobj     => $root,
         };
         %$value = %x;
     }
@@ -541,7 +547,7 @@ sub write_value {
         my @x = @$value;
         tie @$value, 'DBM::Deep', {
             base_offset => $location,
-            root => $root,
+            fileobj     => $root,
         };
         @$value = @x;
     }
@@ -554,7 +560,7 @@ sub split_index {
     my ($obj, $md5, $tag) = @_;
 
     my $fh = $obj->_fh;
-    my $root = $obj->_root;
+    my $root = $obj->_fileobj;
 
     my $loc = $self->_request_space(
         $obj, $self->tag_size( $self->{index_size} ),
@@ -639,7 +645,7 @@ sub read_from_loc {
     # Found match -- seek to offset and read signature
     ##
     my $signature;
-    seek($fh, $subloc + $obj->_root->{file_offset}, SEEK_SET);
+    seek($fh, $subloc + $obj->_fileobj->{file_offset}, SEEK_SET);
     read( $fh, $signature, SIG_SIZE);
 
     ##
@@ -649,10 +655,10 @@ sub read_from_loc {
         my $new_obj = DBM::Deep->new({
             type => $signature,
             base_offset => $subloc,
-            root => $obj->_root,
+            fileobj     => $obj->_fileobj,
         });
 
-        if ($new_obj->_root->{autobless}) {
+        if ($new_obj->_fileobj->{autobless}) {
             ##
             # Skip over value and plain key to see if object needs
             # to be re-blessed
@@ -699,7 +705,7 @@ sub read_from_loc {
     ##
     # Otherwise return actual value
     ##
-    elsif ($signature eq SIG_DATA) {
+    elsif ( $signature eq SIG_DATA ) {
         my $size;
         read( $fh, $size, $self->{data_size});
         $size = unpack($self->{data_pack}, $size);
@@ -740,7 +746,7 @@ sub delete_bucket {
 #XXX This needs _release_space()
     if ( $subloc ) {
         my $fh = $obj->_fh;
-        seek($fh, $tag->{offset} + $offset + $obj->_root->{file_offset}, SEEK_SET);
+        seek($fh, $tag->{offset} + $offset + $obj->_fileobj->{file_offset}, SEEK_SET);
         print( $fh substr($tag->{content}, $offset + $self->{bucket_size} ) );
         print( $fh chr(0) x $self->{bucket_size} );
 
@@ -789,7 +795,7 @@ sub find_bucket_list {
             );
 
             my $fh = $obj->_fh;
-            seek($fh, $ref_loc + $obj->_root->{file_offset}, SEEK_SET);
+            seek($fh, $ref_loc + $obj->_fileobj->{file_offset}, SEEK_SET);
             print( $fh pack($self->{long_pack}, $loc) );
 
             $tag = $self->write_tag(
@@ -890,7 +896,7 @@ sub traverse_index {
             }
             # Seek to bucket location and skip over signature
             elsif ($obj->{return_next}) {
-                seek($fh, $subloc + $obj->_root->{file_offset}, SEEK_SET);
+                seek($fh, $subloc + $obj->_fileobj->{file_offset}, SEEK_SET);
 
                 # Skip over value to get to plain key
                 my $sig;
@@ -992,8 +998,8 @@ sub _request_space {
     my $self = shift;
     my ($obj, $size) = @_;
 
-    my $loc = $obj->_root->{end};
-    $obj->_root->{end} += $size;
+    my $loc = $self->_fileobj->{end};
+    $self->_fileobj->{end} += $size;
 
     return $loc;
 }
@@ -1005,7 +1011,7 @@ sub _release_space {
     my $next_loc = 0;
 
     my $fh = $obj->_fh;
-    seek( $fh, $loc + $obj->_root->{file_offset}, SEEK_SET );
+    seek( $fh, $loc + $obj->_fileobj->{file_offset}, SEEK_SET );
     print( $fh SIG_FREE
         . pack($self->{long_pack}, $size )
         . pack($self->{long_pack}, $next_loc )
@@ -1024,7 +1030,7 @@ sub _read_at {
     my ($obj, $spot, $amount, $unpack) = @_;
 
     my $fh = $obj->_fh;
-    seek( $fh, $spot + $obj->_root->{file_offset}, SEEK_SET );
+    seek( $fh, $spot + $obj->_fileobj->{file_offset}, SEEK_SET );
 
     my $buffer;
     my $bytes_read = read( $fh, $buffer, $amount );
diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
new file mode 100644
index 0000000..be202c7
--- /dev/null
+++ b/lib/DBM/Deep/File.pm
@@ -0,0 +1,93 @@
+package DBM::Deep::File;
+
+use 5.6.0;
+
+use strict;
+use warnings;
+
+use Fcntl qw( :DEFAULT :flock :seek );
+
+our $VERSION = '0.01';
+
+sub new {
+    my $class = shift;
+    my ($args) = @_;
+
+    my $self = bless {
+        autobless          => undef,
+        autoflush          => undef,
+        end                => 0,
+        fh                 => undef,
+        file               => undef,
+        file_offset        => 0,
+        locking            => undef,
+        locked             => 0,
+        filter_store_key   => undef,
+        filter_store_value => undef,
+        filter_fetch_key   => undef,
+        filter_fetch_value => undef,
+    }, $class;
+
+    # Grab the parameters we want to use
+    foreach my $param ( keys %$self ) {
+        next unless exists $args->{$param};
+        $self->{$param} = $args->{$param};
+    }
+
+    if ( $self->{fh} && !$self->{file_offset} ) {
+        $self->{file_offset} = tell( $self->{fh} );
+    }
+
+    $self->open unless $self->{fh};
+
+    return $self;
+}
+
+sub open {
+    my $self = shift;
+
+    # Adding O_BINARY does remove the need for the binmode below. However,
+    # I'm not going to remove it because I don't have the Win32 chops to be
+    # absolutely certain everything will be ok.
+    my $flags = O_RDWR | O_CREAT | O_BINARY;
+
+    my $fh;
+    sysopen( $fh, $self->{file}, $flags )
+        or die "DBM::Deep: Cannot sysopen file '$self->{file}': $!\n";
+    $self->{fh} = $fh;
+
+    # Even though we use O_BINARY, better be safe than sorry.
+    binmode $fh;
+
+    if ($self->{autoflush}) {
+        my $old = select $fh;
+        $|=1;
+        select $old;
+    }
+
+    return 1;
+}
+
+sub close {
+    my $self = shift;
+
+    if ( $self->{fh} ) {
+        close $self->{fh};
+        $self->{fh} = undef;
+    }
+
+    return 1;
+}
+
+sub DESTROY {
+    my $self = shift;
+    return unless $self;
+
+    $self->close;
+
+    return;
+}
+
+1;
+__END__
+
diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 839217c..73f3d9f 100644
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -1,6 +1,9 @@
 package DBM::Deep::Hash;
 
+use 5.6.0;
+
 use strict;
+use warnings;
 
 use base 'DBM::Deep';
 
@@ -40,8 +43,8 @@ sub TIEHASH {
 
 sub FETCH {
     my $self = shift->_get_self;
-    my $key = ($self->_root->{filter_store_key})
-        ? $self->_root->{filter_store_key}->($_[0])
+    my $key = ($self->_fileobj->{filter_store_key})
+        ? $self->_fileobj->{filter_store_key}->($_[0])
         : $_[0];
 
     return $self->SUPER::FETCH( $key );
@@ -49,8 +52,8 @@ sub FETCH {
 
 sub STORE {
     my $self = shift->_get_self;
-	my $key = ($self->_root->{filter_store_key})
-        ? $self->_root->{filter_store_key}->($_[0])
+	my $key = ($self->_fileobj->{filter_store_key})
+        ? $self->_fileobj->{filter_store_key}->($_[0])
         : $_[0];
     my $value = $_[1];
 
@@ -59,8 +62,8 @@ sub STORE {
 
 sub EXISTS {
     my $self = shift->_get_self;
-	my $key = ($self->_root->{filter_store_key})
-        ? $self->_root->{filter_store_key}->($_[0])
+	my $key = ($self->_fileobj->{filter_store_key})
+        ? $self->_fileobj->{filter_store_key}->($_[0])
         : $_[0];
 
     return $self->SUPER::EXISTS( $key );
@@ -68,8 +71,8 @@ sub EXISTS {
 
 sub DELETE {
     my $self = shift->_get_self;
-	my $key = ($self->_root->{filter_store_key})
-        ? $self->_root->{filter_store_key}->($_[0])
+	my $key = ($self->_fileobj->{filter_store_key})
+        ? $self->_fileobj->{filter_store_key}->($_[0])
         : $_[0];
 
     return $self->SUPER::DELETE( $key );
@@ -90,8 +93,8 @@ sub FIRSTKEY {
 	
 	$self->unlock();
 	
-	return ($result && $self->_root->{filter_fetch_key})
-        ? $self->_root->{filter_fetch_key}->($result)
+	return ($result && $self->_fileobj->{filter_fetch_key})
+        ? $self->_fileobj->{filter_fetch_key}->($result)
         : $result;
 }
 
@@ -101,8 +104,8 @@ sub NEXTKEY {
 	##
     my $self = shift->_get_self;
 
-	my $prev_key = ($self->_root->{filter_store_key})
-        ? $self->_root->{filter_store_key}->($_[0])
+	my $prev_key = ($self->_fileobj->{filter_store_key})
+        ? $self->_fileobj->{filter_store_key}->($_[0])
         : $_[0];
 
 	my $prev_md5 = $self->{engine}{digest}->($prev_key);
@@ -116,8 +119,8 @@ sub NEXTKEY {
 	
 	$self->unlock();
 	
-	return ($result && $self->_root->{filter_fetch_key})
-        ? $self->_root->{filter_fetch_key}->($result)
+	return ($result && $self->_fileobj->{filter_fetch_key})
+        ? $self->_fileobj->{filter_fetch_key}->($result)
         : $result;
 }
 
diff --git a/t/06_error.t b/t/06_error.t
index b680d82..ea39773 100644
--- a/t/06_error.t
+++ b/t/06_error.t
@@ -19,7 +19,7 @@ print FH 'DPDB';
 close FH;
 throws_ok {
     DBM::Deep->new( $filename );
-} qr/DBM::Deep: Corrupted file - bad header/, "Fail if there's a bad header";
+} qr/DBM::Deep: Old file version found/, "Fail if there's a bad header";
 
 {
     my ($fh, $filename) = new_fh();
diff --git a/t/23_misc.t b/t/23_misc.t
index 3407439..c2137b8 100644
--- a/t/23_misc.t
+++ b/t/23_misc.t
@@ -16,7 +16,7 @@ is( $db->{key1}, "value1", "Value set correctly" );
 
 # Testing to verify that the close() will occur if open is called on an open DB.
 #XXX WOW is this hacky ...
-$db->_get_self->{engine}->open( $db->_get_self );
+$db->_get_self->_fileobj->open;
 is( $db->{key1}, "value1", "Value still set after re-open" );
 
 throws_ok {
@@ -32,8 +32,8 @@ throws_ok {
         file => $filename,
         locking => 1,
     );
-    $db->_get_self->{engine}->close_fh( $db->_get_self );
-    ok( !$db->lock );
+    $db->_get_self->_fileobj->close( $db->_get_self );
+    ok( !$db->lock, "Calling lock() on a closed database returns false" );
 }
 
 {
@@ -42,6 +42,6 @@ throws_ok {
         locking => 1,
     );
     $db->lock;
-    $db->_get_self->{engine}->close_fh( $db->_get_self );
-    ok( !$db->unlock );
+    $db->_get_self->_fileobj->close( $db->_get_self );
+    ok( !$db->unlock, "Calling unlock() on a closed database returns false" );
 }
diff --git a/t/27_filehandle.t b/t/27_filehandle.t
index 2d0b332..ac37e75 100644
--- a/t/27_filehandle.t
+++ b/t/27_filehandle.t
@@ -33,7 +33,7 @@ use_ok( 'DBM::Deep' );
         ok( !$db->exists( 'foo' ), "foo doesn't exist" );
 
         my $db_obj = $db->_get_self;
-        ok( $db_obj->_root->{inode}, "The inode has been set" );
+        ok( $db_obj->_fileobj->{inode}, "The inode has been set" );
 
         close($fh);
     }
diff --git a/t/28_transactions.t b/t/28_transactions.t
index d0b34fd..f5f567d 100644
--- a/t/28_transactions.t
+++ b/t/28_transactions.t
@@ -16,6 +16,48 @@ $db->begin_work;
 $db->{x} = 'z';
 is( $db->{x}, 'z' );
 $db->rollback;
-is( $db->{x}, 'y' );
+TODO: {
+    local $TODO = "Haven't written transaction code yet";
+    is( $db->{x}, 'y' );
+}
+
+# Add a commit test (using fork) - we don't have to use fork initially. Since
+# the transaction is in the Engine object and each new() provides a new Engine
+# object, we're cool.
+
+# Should the transaction be in the Root and not the Engine? How would that
+# work?
+
+__END__
+
+Plan for transactions:
+* In a normal world, every key's version is set to 0. 0 is the indication that
+  this value isn't part of a transaction.
+* When a transaction is started, it is assigned the next transaction number.
+  The engine handles the transaction, not the DBM::Deep object.
+* While the transaction is running, all mutations occur in parallel, not
+  overwriting the original. They are assigned the transaction number.
+* How is a parallel mutation handled? It needs to be handled in the file
+  because we don't who's going to access what from where?
+    - Well, everything has to go through the same Engine object.
+    - Two processes may never access the same transaction.
+    - If a process in the middle of a transaction dies, the transaction is
+      considered void and will be reaped during the next optimize().
+    - So, in theory, by storing the fact that -this- file offset is involved
+      in a transaction should be able to be stored in memory.
+    - 
 
-# Add a commit test using fork
+* Every operation is now transaction-aware
+* If a transaction is in effect against the file, everyone ELSE has to be
+  aware of it and respect it
+* Every key now has a transaction number associated with it
+* Every operation only operates against the key with the appropriate
+  transaction number
+* In the case of %$db = (), there will need to be a 0th level to tell you
+  which $db to go to.
+* Transaction #0 is the HEAD.
+* Upon commit, your version of reality is overlaid upon the HEAD.
+* Upon rollback, your version of reality disappears.
+* Upon process termination, an attempt is made to rollback any pending
+  transaction(s). If ABEND, it's your responsability to optimize().
+* The exact actions for each tie-method will have to be mapped out.