X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep%2FEngine.pm;h=e9d0711e164412d0c627c7da56e61ffbd1772b15;hb=42717e465f8d960a2a416cd681e1247f35f5e6f3;hp=983b3e9b8b444da5c9093c507c6b1a72921440e8;hpb=359a01ac3d83b1713bfee3a473d6959c21632d26;p=dbsrgits%2FDBM-Deep.git

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 983b3e9..e9d0711 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -5,11 +5,10 @@ use 5.6.0;
 use strict;
 use warnings;
 
-use Fcntl qw( :DEFAULT :flock :seek );
+use Fcntl qw( :DEFAULT :flock );
 use Scalar::Util ();
 
 # File-wide notes:
-# * All the local($/,$\); are to protect read() and print() from -l.
 # * To add to bucket_size, make sure you modify the following:
 #   - calculate_sizes()
 #   - _get_key_subloc()
@@ -89,11 +88,12 @@ sub new {
 }
 
 sub _fileobj { return $_[0]{fileobj} }
-sub _fh      { return $_[0]->_fileobj->{fh} }
 
 sub calculate_sizes {
     my $self = shift;
 
+    # The 2**8 here indicates the number of different characters in the
+    # current hashing algorithm
     #XXX Does this need to be updated with different hashing algorithms?
     $self->{index_size}       = (2**8) * $self->{long_size};
     $self->{bucket_size}      = $self->{hash_size} + $self->{long_size} * 3;
@@ -105,13 +105,9 @@ sub calculate_sizes {
 sub write_file_header {
     my $self = shift;
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
+    my $loc = $self->_fileobj->request_space( length( SIG_FILE ) + 21 );
 
-    my $loc = $self->_request_space( length( SIG_FILE ) + 21 );
-    seek($fh, $loc + $self->_fileobj->{file_offset}, SEEK_SET);
-    print( $fh
+    $self->_fileobj->print_at( $loc,
         SIG_FILE,
         SIG_HEADER,
         pack('N', 1),  # header version
@@ -132,15 +128,8 @@ sub write_file_header {
 sub read_file_header {
     my $self = shift;
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
-
-    seek($fh, 0 + $self->_fileobj->{file_offset}, SEEK_SET);
-    my $buffer;
-    my $bytes_read = read( $fh, $buffer, length(SIG_FILE) + 9 );
-
-    return unless $bytes_read;
+    my $buffer = $self->_fileobj->read_at( 0, length(SIG_FILE) + 9 );
+    return unless length($buffer);
 
     my ($file_signature, $sig_header, $header_version, $size) = unpack(
         'A4 A N N', $buffer
@@ -156,8 +145,7 @@ sub read_file_header {
         $self->_throw_error( "Old file version found." );
     }
 
-    my $buffer2;
-    $bytes_read += read( $fh, $buffer2, $size );
+    my $buffer2 = $self->_fileobj->read_at( undef, $size );
     my ($running_transactions, @values) = unpack( 'N n A n A n', $buffer2 );
 
     $self->_fileobj->set_transaction_offset( 13 );
@@ -170,16 +158,15 @@ sub read_file_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;
+    return length($buffer) + length($buffer2);
 }
 
 sub setup_fh {
     my $self = shift;
     my ($obj) = @_;
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
+    # Need to remove use of $fh here
+    my $fh = $self->_fileobj->{fh};
     flock $fh, LOCK_EX;
 
     #XXX The duplication of calculate_sizes needs to go away
@@ -192,15 +179,13 @@ sub setup_fh {
         # File is empty -- write header and master index
         ##
         if (!$bytes_read) {
-            if ( my $afh = $self->_fileobj->{audit_fh} ) {
-                flock( $afh, LOCK_EX );
-                print( $afh "# Database created on " . localtime(time) . "\n" );
-                flock( $afh, LOCK_UN );
-            }
+            $self->_fileobj->audit( "# Database created on" );
 
             $self->write_file_header;
 
-            $obj->{base_offset} = $self->_request_space( $self->tag_size( $self->{index_size} ) );
+            $obj->{base_offset} = $self->_fileobj->request_space(
+                $self->tag_size( $self->{index_size} ),
+            );
 
             $self->write_tag(
                 $obj->_base_offset, $obj->_type,
@@ -235,11 +220,7 @@ sub setup_fh {
     }
 
     #XXX We have to make sure we don't mess up when autoflush isn't turned on
-    unless ( $self->_fileobj->{inode} ) {
-        my @stats = stat($fh);
-        $self->_fileobj->{inode} = $stats[1];
-        $self->_fileobj->{end} = $stats[7];
-    }
+    $self->_fileobj->set_inode;
 
     flock $fh, LOCK_UN;
 
@@ -260,15 +241,10 @@ sub write_tag {
     my ($offset, $sig, $content) = @_;
     my $size = length( $content );
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
-
-    if ( defined $offset ) {
-        seek($fh, $offset + $self->_fileobj->{file_offset}, SEEK_SET);
-    }
-
-    print( $fh $sig . pack($self->{data_pack}, $size) . $content );
+    $self->_fileobj->print_at(
+        $offset, 
+        $sig, pack($self->{data_pack}, $size), $content,
+    );
 
     return unless defined $offset;
 
@@ -287,23 +263,13 @@ sub load_tag {
     my $self = shift;
     my ($offset) = @_;
 
-    local($/,$\);
-
-#    print join(':',map{$_||''}caller(1)), $/;
-
-    my $fh = $self->_fh;
+    my $fileobj = $self->_fileobj;
 
-    seek($fh, $offset + $self->_fileobj->{file_offset}, SEEK_SET);
-
-    #XXX I'm not sure this check will work if autoflush isn't enabled ...
-    return if eof $fh;
-
-    my $b;
-    read( $fh, $b, SIG_SIZE + $self->{data_size} );
+    my $s = SIG_SIZE + $self->{data_size};
+    my $b = $fileobj->read_at( $offset, $s );
     my ($sig, $size) = unpack( "A $self->{data_pack}", $b );
 
-    my $buffer;
-    read( $fh, $buffer, $size);
+    my $buffer = $fileobj->read_at( undef, $size );
 
     return {
         signature => $sig,
@@ -361,19 +327,22 @@ sub _length_needed {
         $value->isa( 'DBM::Deep' );
     };
 
-    my $len = SIG_SIZE + $self->{data_size}
-            + $self->{data_size} + length( $key );
+    my $len = SIG_SIZE
+            + $self->{data_size} # size for value
+            + $self->{data_size} # size for key
+            + length( $key );    # length of key
 
     if ( $is_dbm_deep && $value->_fileobj eq $self->_fileobj ) {
+        # long_size is for the internal reference
         return $len + $self->{long_size};
     }
 
-    my $r = Scalar::Util::reftype( $value ) || '';
     if ( $self->_fileobj->{autobless} ) {
         # This is for the bit saying whether or not this thing is blessed.
         $len += 1;
     }
 
+    my $r = Scalar::Util::reftype( $value ) || '';
     unless ( $r eq 'HASH' || $r eq 'ARRAY' ) {
         if ( defined $value ) {
             $len += length( $value );
@@ -422,8 +391,7 @@ sub add_bucket {
     my $location = 0;
     my $result = 2;
 
-    my $root = $self->_fileobj;
-    my $fh   = $self->_fh;
+    my $fileobj = $self->_fileobj;
 
     my $actual_length = $self->_length_needed( $value, $plain_key );
 
@@ -431,8 +399,8 @@ sub add_bucket {
     my ($subloc, $offset, $size,$is_deleted) = $self->_find_in_buckets( $tag, $md5, 1 );
 
     my @transactions;
-    if ( $self->_fileobj->transaction_id == 0 ) {
-        @transactions = $self->_fileobj->current_transactions;
+    if ( $fileobj->transaction_id == 0 ) {
+        @transactions = $fileobj->current_transactions;
     }
 
 #    $self->_release_space( $size, $subloc );
@@ -445,36 +413,36 @@ sub add_bucket {
             $location = $subloc;
         }
         else {
-            $location = $self->_request_space( $actual_length );
-            seek(
-                $fh,
-                $tag->{offset} + $offset
-              + $self->{hash_size} + $root->{file_offset},
-                SEEK_SET,
+            $location = $fileobj->request_space( $actual_length );
+
+            $fileobj->print_at( $tag->{offset} + $offset + $self->{hash_size},
+                pack($self->{long_pack}, $location ),
+                pack($self->{long_pack}, $actual_length ),
+                pack('n n', $fileobj->transaction_id, $deleted ),
             );
-            print( $fh pack($self->{long_pack}, $location ) );
-            print( $fh pack($self->{long_pack}, $actual_length ) );
-            print( $fh pack('n n', $root->transaction_id, $deleted ) );
         }
     }
     # Adding a new md5
     elsif ( defined $offset ) {
-        $location = $self->_request_space( $actual_length );
+        $location = $fileobj->request_space( $actual_length );
 
-        seek( $fh, $tag->{offset} + $offset + $root->{file_offset}, SEEK_SET );
-        print( $fh $md5 . pack($self->{long_pack}, $location ) );
-        print( $fh pack($self->{long_pack}, $actual_length ) );
-        print( $fh pack('n n', $root->transaction_id, $deleted ) );
+        $fileobj->print_at( $tag->{offset} + $offset,
+            $md5,
+            pack($self->{long_pack}, $location ),
+            pack($self->{long_pack}, $actual_length ),
+            pack('n n', $fileobj->transaction_id, $deleted ),
+        );
 
         for ( @transactions ) {
             my $tag2 = $self->load_tag( $tag->{offset} - SIG_SIZE - $self->{data_size} );
-            $self->_fileobj->{transaction_id} = $_;
+            $fileobj->{transaction_id} = $_;
             $self->add_bucket( $tag2, $md5, '', '', 1, $orig_key );
-            $self->_fileobj->{transaction_id} = 0;
+            $fileobj->{transaction_id} = 0;
         }
+        $tag = $self->load_tag( $tag->{offset} - SIG_SIZE - $self->{data_size} );
     }
     # If bucket didn't fit into list, split into a new index level
-    # split_index() will do the _request_space() call
+    # split_index() will do the _fileobj->request_space() call
     else {
         $location = $self->split_index( $md5, $tag );
     }
@@ -488,49 +456,44 @@ sub write_value {
     my $self = shift;
     my ($location, $key, $value, $orig_key) = @_;
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
-    my $root = $self->_fileobj;
+    my $fileobj = $self->_fileobj;
 
     my $dbm_deep_obj = _get_dbm_object( $value );
-    if ( $dbm_deep_obj && $dbm_deep_obj->_fileobj ne $self->_fileobj ) {
+    if ( $dbm_deep_obj && $dbm_deep_obj->_fileobj ne $fileobj ) {
         $self->_throw_error( "Cannot cross-reference. Use export() instead" );
     }
 
-    seek($fh, $location + $root->{file_offset}, SEEK_SET);
-
     ##
     # Write signature based on content type, set content length and write
     # actual value.
     ##
     my $r = Scalar::Util::reftype( $value ) || '';
     if ( $dbm_deep_obj ) {
-        $self->write_tag( undef, SIG_INTERNAL,pack($self->{long_pack}, $dbm_deep_obj->_base_offset) );
+        $self->write_tag( $location, SIG_INTERNAL,pack($self->{long_pack}, $dbm_deep_obj->_base_offset) );
     }
     elsif ($r eq 'HASH') {
         if ( !$dbm_deep_obj && tied %{$value} ) {
             $self->_throw_error( "Cannot store something that is tied" );
         }
-        $self->write_tag( undef, SIG_HASH, chr(0)x$self->{index_size} );
+        $self->write_tag( $location, SIG_HASH, chr(0)x$self->{index_size} );
     }
     elsif ($r eq 'ARRAY') {
         if ( !$dbm_deep_obj && tied @{$value} ) {
             $self->_throw_error( "Cannot store something that is tied" );
         }
-        $self->write_tag( undef, SIG_ARRAY, chr(0)x$self->{index_size} );
+        $self->write_tag( $location, SIG_ARRAY, chr(0)x$self->{index_size} );
     }
     elsif (!defined($value)) {
-        $self->write_tag( undef, SIG_NULL, '' );
+        $self->write_tag( $location, SIG_NULL, '' );
     }
     else {
-        $self->write_tag( undef, SIG_DATA, $value );
+        $self->write_tag( $location, SIG_DATA, $value );
     }
 
     ##
     # Plain key is stored AFTER value, as keys are typically fetched less often.
     ##
-    print( $fh pack($self->{data_pack}, length($key)) . $key );
+    $fileobj->print_at( undef, pack($self->{data_pack}, length($key)) . $key );
 
     # Internal references don't care about autobless
     return 1 if $dbm_deep_obj;
@@ -538,14 +501,12 @@ sub write_value {
     ##
     # If value is blessed, preserve class name
     ##
-    if ( $root->{autobless} ) {
-        my $c = Scalar::Util::blessed($value);
-        if ( defined $c && !$dbm_deep_obj ) {
-            print( $fh chr(1) );
-            print( $fh pack($self->{data_pack}, length($c)) . $c );
+    if ( $fileobj->{autobless} ) {
+        if ( defined( my $c = Scalar::Util::blessed($value) ) ) {
+            $fileobj->print_at( undef, chr(1), pack($self->{data_pack}, length($c)) . $c );
         }
         else {
-            print( $fh chr(0) );
+            $fileobj->print_at( undef, chr(0) );
         }
     }
 
@@ -561,7 +522,7 @@ sub write_value {
         my %x = %$value;
         tie %$value, 'DBM::Deep', {
             base_offset => $location,
-            fileobj     => $root,
+            fileobj     => $fileobj,
             parent      => $self->{obj},
             parent_key  => $orig_key,
         };
@@ -571,7 +532,7 @@ sub write_value {
         my @x = @$value;
         tie @$value, 'DBM::Deep', {
             base_offset => $location,
-            fileobj     => $root,
+            fileobj     => $fileobj,
             parent      => $self->{obj},
             parent_key  => $orig_key,
         };
@@ -585,24 +546,20 @@ sub split_index {
     my $self = shift;
     my ($md5, $tag) = @_;
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
-    my $root = $self->_fileobj;
+    my $fileobj = $self->_fileobj;
 
-    my $loc = $self->_request_space(
+    my $loc = $fileobj->request_space(
         $self->tag_size( $self->{index_size} ),
     );
 
-    seek($fh, $tag->{ref_loc} + $root->{file_offset}, SEEK_SET);
-    print( $fh pack($self->{long_pack}, $loc) );
+    $fileobj->print_at( $tag->{ref_loc}, pack($self->{long_pack}, $loc) );
 
     my $index_tag = $self->write_tag(
         $loc, SIG_INDEX,
         chr(0)x$self->{index_size},
     );
 
-    my $newtag_loc = $self->_request_space(
+    my $newtag_loc = $fileobj->request_space(
         $self->tag_size( $self->{bucket_list_size} ),
     );
 
@@ -613,6 +570,8 @@ sub split_index {
 
     my @newloc = ();
     BUCKET:
+    # The <= here is deliberate - we have max_buckets+1 keys to iterate
+    # through, unlike every other loop that uses max_buckets as a stop.
     for (my $i = 0; $i <= $self->{max_buckets}; $i++) {
         my ($key, $old_subloc, $size) = $self->_get_key_subloc( $keys, $i );
 
@@ -622,36 +581,36 @@ sub split_index {
         my $num = ord(substr($key, $tag->{ch} + 1, 1));
 
         if ($newloc[$num]) {
-            seek($fh, $newloc[$num] + $root->{file_offset}, SEEK_SET);
-            my $subkeys;
-            read( $fh, $subkeys, $self->{bucket_list_size});
+            my $subkeys = $fileobj->read_at( $newloc[$num], $self->{bucket_list_size} );
 
             # This is looking for the first empty spot
             my ($subloc, $offset, $size) = $self->_find_in_buckets(
                 { content => $subkeys }, '',
             );
 
-            seek($fh, $newloc[$num] + $offset + $root->{file_offset}, SEEK_SET);
-            print( $fh $key . pack($self->{long_pack}, $old_subloc) );
+            $fileobj->print_at(
+                $newloc[$num] + $offset,
+                $key, pack($self->{long_pack}, $old_subloc),
+            );
 
             next;
         }
 
-        seek($fh, $index_tag->{offset} + ($num * $self->{long_size}) + $root->{file_offset}, SEEK_SET);
-
-        my $loc = $self->_request_space(
+        my $loc = $fileobj->request_space(
             $self->tag_size( $self->{bucket_list_size} ),
         );
 
-        print( $fh pack($self->{long_pack}, $loc) );
+        $fileobj->print_at(
+            $index_tag->{offset} + ($num * $self->{long_size}),
+            pack($self->{long_pack}, $loc),
+        );
 
         my $blist_tag = $self->write_tag(
             $loc, SIG_BLIST,
             chr(0)x$self->{bucket_list_size},
         );
 
-        seek($fh, $blist_tag->{offset} + $root->{file_offset}, SEEK_SET);
-        print( $fh $key . pack($self->{long_pack}, $old_subloc) );
+        $fileobj->print_at( $blist_tag->{offset}, $key . pack($self->{long_pack}, $old_subloc) );
 
         $newloc[$num] = $blist_tag->{offset};
     }
@@ -668,16 +627,9 @@ sub read_from_loc {
     my $self = shift;
     my ($subloc, $orig_key) = @_;
 
-    local($/,$\);
-
-    my $fh = $self->_fh;
+    my $fileobj = $self->_fileobj;
 
-    ##
-    # Found match -- seek to offset and read signature
-    ##
-    my $signature;
-    seek($fh, $subloc + $self->_fileobj->{file_offset}, SEEK_SET);
-    read( $fh, $signature, SIG_SIZE);
+    my $signature = $fileobj->read_at( $subloc, SIG_SIZE );
 
     ##
     # If value is a hash or array, return new DBM::Deep object with correct offset
@@ -696,39 +648,35 @@ sub read_from_loc {
             # Skip over value and plain key to see if object needs
             # to be re-blessed
             ##
-            seek($fh, $self->{data_size} + $self->{index_size}, SEEK_CUR);
+            $fileobj->increment_pointer( $self->{data_size} + $self->{index_size} );
 
-            my $size;
-            read( $fh, $size, $self->{data_size});
+            my $size = $fileobj->read_at( undef, $self->{data_size} );
             $size = unpack($self->{data_pack}, $size);
-            if ($size) { seek($fh, $size, SEEK_CUR); }
+            if ($size) { $fileobj->increment_pointer( $size ); }
 
-            my $bless_bit;
-            read( $fh, $bless_bit, 1);
+            my $bless_bit = $fileobj->read_at( undef, 1 );
             if (ord($bless_bit)) {
                 ##
                 # Yes, object needs to be re-blessed
                 ##
-                my $class_name;
-                read( $fh, $size, $self->{data_size});
+                my $size = $fileobj->read_at( undef, $self->{data_size} );
                 $size = unpack($self->{data_pack}, $size);
-                if ($size) { read( $fh, $class_name, $size); }
-                if ($class_name) { $new_obj = bless( $new_obj, $class_name ); }
+
+                my $class_name;
+                if ($size) { $class_name = $fileobj->read_at( undef, $size ); }
+                if (defined $class_name) { $new_obj = bless( $new_obj, $class_name ); }
             }
         }
 
         return $new_obj;
     }
     elsif ( $signature eq SIG_INTERNAL ) {
-        my $size;
-        read( $fh, $size, $self->{data_size});
+        my $size = $fileobj->read_at( undef, $self->{data_size} );
         $size = unpack($self->{data_pack}, $size);
 
         if ( $size ) {
-            my $new_loc;
-            read( $fh, $new_loc, $size );
-            $new_loc = unpack( $self->{long_pack}, $new_loc );
-
+            my $new_loc = $fileobj->read_at( undef, $size );
+            $new_loc = unpack( $self->{long_pack}, $new_loc ); 
             return $self->read_from_loc( $new_loc, $orig_key );
         }
         else {
@@ -739,12 +687,11 @@ sub read_from_loc {
     # Otherwise return actual value
     ##
     elsif ( $signature eq SIG_DATA ) {
-        my $size;
-        read( $fh, $size, $self->{data_size});
+        my $size = $fileobj->read_at( undef, $self->{data_size} );
         $size = unpack($self->{data_pack}, $size);
 
         my $value = '';
-        if ($size) { read( $fh, $value, $size); }
+        if ($size) { $value = $fileobj->read_at( undef, $size ); }
         return $value;
     }
 
@@ -762,10 +709,17 @@ sub get_bucket_value {
     my ($tag, $md5, $orig_key) = @_;
 
     #ACID - This is a read. Can find exact or HEAD
-    my ($subloc, $offset, $size,$is_deleted) = $self->_find_in_buckets( $tag, $md5 );
-    if ( $subloc && !$is_deleted ) {
+    my ($subloc, $offset, $size, $is_deleted) = $self->_find_in_buckets( $tag, $md5 );
+
+    if ( !$subloc ) {
+        #XXX Need to use real key
+#        $self->add_bucket( $tag, $md5, $orig_key, undef, undef, $orig_key );
+#        return;
+    }
+    elsif ( !$is_deleted ) {
         return $self->read_from_loc( $subloc, $orig_key );
     }
+
     return;
 }
 
@@ -774,22 +728,44 @@ sub delete_bucket {
     # Delete single key/value pair given tag and MD5 digested key.
     ##
     my $self = shift;
-    my ($tag, $md5) = @_;
+    my ($tag, $md5, $orig_key) = @_;
 
-    local($/,$\);
+    #ACID - Although this is a mutation, we must find any transaction.
+    # This is because we need to mark something as deleted that is in the HEAD.
+    my ($subloc, $offset, $size,$is_deleted) = $self->_find_in_buckets( $tag, $md5 );
 
-    #ACID - This is a mutation. Must only find the exact transaction
-    my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5, 1 );
-#XXX This needs _release_space()
-    if ( $subloc ) {
-        my $fh = $self->_fh;
-        seek($fh, $tag->{offset} + $offset + $self->_fileobj->{file_offset}, SEEK_SET);
-        print( $fh substr($tag->{content}, $offset + $self->{bucket_size} ) );
-        print( $fh chr(0) x $self->{bucket_size} );
+    return if !$subloc;
+
+    my $fileobj = $self->_fileobj;
 
-        return 1;
+    my @transactions;
+    if ( $fileobj->transaction_id == 0 ) {
+        @transactions = $fileobj->current_transactions;
     }
-    return;
+
+    if ( $fileobj->transaction_id == 0 ) {
+        my $value = $self->read_from_loc( $subloc, $orig_key );
+
+        for (@transactions) {
+            $fileobj->{transaction_id} = $_;
+            #XXX Need to use real key
+            $self->add_bucket( $tag, $md5, $orig_key, $value, undef, $orig_key );
+            $fileobj->{transaction_id} = 0;
+        }
+        $tag = $self->load_tag( $tag->{offset} - SIG_SIZE - $self->{data_size} );
+
+        #XXX This needs _release_space() for the value and anything below
+        $fileobj->print_at(
+            $tag->{offset} + $offset,
+            substr( $tag->{content}, $offset + $self->{bucket_size} ),
+            chr(0) x $self->{bucket_size},
+        );
+    }
+    else {
+        $self->add_bucket( $tag, $md5, '', '', 1, $orig_key );
+    }
+
+    return 1;
 }
 
 sub bucket_exists {
@@ -830,13 +806,11 @@ sub find_bucket_list {
         if (!$tag) {
             return if !$args->{create};
 
-            my $loc = $self->_request_space(
+            my $loc = $self->_fileobj->request_space(
                 $self->tag_size( $self->{bucket_list_size} ),
             );
 
-            my $fh = $self->_fh;
-            seek($fh, $ref_loc + $self->_fileobj->{file_offset}, SEEK_SET);
-            print( $fh pack($self->{long_pack}, $loc) );
+            $self->_fileobj->print_at( $ref_loc, pack($self->{long_pack}, $loc) );
 
             $tag = $self->write_tag(
                 $loc, SIG_BLIST,
@@ -884,12 +858,8 @@ sub traverse_index {
     my $self = shift;
     my ($obj, $offset, $ch, $force_return_next) = @_;
 
-    local($/,$\);
-
     my $tag = $self->load_tag( $offset );
 
-    my $fh = $self->_fh;
-
     if ($tag->{signature} ne SIG_BLIST) {
         my $content = $tag->{content};
         my $start = $obj->{return_next} ? 0 : ord(substr($obj->{prev_md5}, $ch, 1));
@@ -914,8 +884,8 @@ sub traverse_index {
         } # index loop
 
         $obj->{return_next} = 1;
-    } # tag is an index
-
+    }
+    # This is the bucket list
     else {
         my $keys = $tag->{content};
         if ($force_return_next) { $obj->{return_next} = 1; }
@@ -923,8 +893,14 @@ sub traverse_index {
         ##
         # Iterate through buckets, looking for a key match
         ##
+        my $transaction_id = $self->_fileobj->transaction_id;
         for (my $i = 0; $i < $self->{max_buckets}; $i++) {
-            my ($key, $subloc) = $self->_get_key_subloc( $keys, $i );
+            my ($key, $subloc, $size, $trans_id, $is_deleted) = $self->_get_key_subloc( $keys, $i );
+
+            next if $is_deleted;
+#XXX Need to find all the copies of this key to find out if $transaction_id has it
+#XXX marked as deleted, in use, or what.
+            next if $trans_id && $trans_id != $transaction_id;
 
             # End of bucket list -- return to outer loop
             if (!$subloc) {
@@ -938,29 +914,27 @@ sub traverse_index {
             }
             # Seek to bucket location and skip over signature
             elsif ($obj->{return_next}) {
-                seek($fh, $subloc + $self->_fileobj->{file_offset}, SEEK_SET);
+                my $fileobj = $self->_fileobj;
 
                 # Skip over value to get to plain key
-                my $sig;
-                read( $fh, $sig, SIG_SIZE );
+                my $sig = $fileobj->read_at( $subloc, SIG_SIZE );
 
-                my $size;
-                read( $fh, $size, $self->{data_size});
+                my $size = $fileobj->read_at( undef, $self->{data_size} );
                 $size = unpack($self->{data_pack}, $size);
-                if ($size) { seek($fh, $size, SEEK_CUR); }
+                if ($size) { $fileobj->increment_pointer( $size ); }
 
                 # Read in plain key and return as scalar
-                my $plain_key;
-                read( $fh, $size, $self->{data_size});
+                $size = $fileobj->read_at( undef, $self->{data_size} );
                 $size = unpack($self->{data_pack}, $size);
-                if ($size) { read( $fh, $plain_key, $size); }
+                my $plain_key;
+                if ($size) { $plain_key = $fileobj->read_at( undef, $size); }
 
                 return $plain_key;
             }
         }
 
         $obj->{return_next} = 1;
-    } # tag is a bucket list
+    }
 
     return;
 }
@@ -1010,6 +984,7 @@ sub _get_key_subloc {
 sub _find_in_buckets {
     my $self = shift;
     my ($tag, $md5, $exact) = @_;
+    $exact ||= 0;
 
     my $trans_id = $self->_fileobj->transaction_id;
 
@@ -1024,7 +999,7 @@ sub _find_in_buckets {
         my @rv = ($subloc, $i * $self->{bucket_size}, $size, $is_deleted);
 
         unless ( $subloc ) {
-            if ( !$exact && @zero and $trans_id ) {
+            if ( !$exact && @zero && $trans_id ) {
                 @rv = ($zero[2], $zero[0] * $self->{bucket_size},$zero[3],$is_deleted);
             }
             return @rv;
@@ -1043,29 +1018,16 @@ sub _find_in_buckets {
     return;
 }
 
-sub _request_space {
-    my $self = shift;
-    my ($size) = @_;
-
-    my $loc = $self->_fileobj->{end};
-    $self->_fileobj->{end} += $size;
-
-    return $loc;
-}
-
 sub _release_space {
     my $self = shift;
     my ($size, $loc) = @_;
 
-    local($/,$\);
-
     my $next_loc = 0;
 
-    my $fh = $self->_fh;
-    seek( $fh, $loc + $self->_fileobj->{file_offset}, SEEK_SET );
-    print( $fh SIG_FREE
-        . pack($self->{long_pack}, $size )
-        . pack($self->{long_pack}, $next_loc )
+    $self->_fileobj->print_at( $loc,
+        SIG_FREE, 
+        pack($self->{long_pack}, $size ),
+        pack($self->{long_pack}, $next_loc ),
     );
 
     return;
@@ -1077,74 +1039,3 @@ sub _throw_error {
 
 1;
 __END__
-
-# This will be added in later, after more refactoring is done. This is an early
-# attempt at refactoring on the physical level instead of the virtual level.
-sub _read_at {
-    my $self = shift;
-    my ($spot, $amount, $unpack) = @_;
-
-    local($/,$\);
-
-    my $fh = $self->_fh;
-    seek( $fh, $spot + $self->_fileobj->{file_offset}, SEEK_SET );
-
-    my $buffer;
-    my $bytes_read = read( $fh, $buffer, $amount );
-
-    if ( $unpack ) {
-        $buffer = unpack( $unpack, $buffer );
-    }
-
-    if ( wantarray ) {
-        return ($buffer, $bytes_read);
-    }
-    else {
-        return $buffer;
-    }
-}
-
-sub _print_at {
-    my $self = shift;
-    my ($spot, $data) = @_;
-
-    local($/,$\);
-
-    my $fh = $self->_fh;
-    seek( $fh, $spot, SEEK_SET );
-    print( $fh $data );
-
-    return;
-}
-
-sub get_file_version {
-    my $self = shift;
-
-    local($/,$\);
-
-    my $fh = $self->_fh;
-
-    seek( $fh, 13 + $self->_fileobj->{file_offset}, SEEK_SET );
-    my $buffer;
-    my $bytes_read = read( $fh, $buffer, 4 );
-    unless ( $bytes_read == 4 ) {
-        $self->_throw_error( "Cannot read file version" );
-    }
-
-    return unpack( 'N', $buffer );
-}
-
-sub write_file_version {
-    my $self = shift;
-    my ($new_version) = @_;
-
-    local($/,$\);
-
-    my $fh = $self->_fh;
-
-    seek( $fh, 13 + $self->_fileobj->{file_offset}, SEEK_SET );
-    print( $fh pack( 'N', $new_version ) );
-
-    return;
-}
-