Branched for fixes off of 0.98

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 6aeaed8..8e27817 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -102,14 +102,13 @@ sub _init {
     # Setup $self and bless into this class.
     ##
     my $class = shift;
-    my $args = shift;
+    my ($args) = @_;
 
     # These are the defaults to be optionally overridden below
     my $self = bless {
         type        => TYPE_HASH,
         engine      => DBM::Deep::Engine->new,
     }, $class;
-
     $self->{base_offset} = length( $self->{engine}->SIG_FILE );
 
     foreach my $param ( keys %$self ) {
@@ -151,8 +150,8 @@ sub lock {
     # times before unlock(), then the same number of unlocks() must
     # be called before the lock is released.
     ##
-    my $self = $_[0]->_get_self;
-    my $type = $_[1];
+    my $self = shift->_get_self;
+    my ($type) = @_;
     $type = LOCK_EX unless defined $type;
 
     if (!defined($self->_fh)) { return; }
@@ -189,7 +188,7 @@ sub unlock {
     # If db locking is set, unlock the db file.  See note in lock()
     # regarding calling lock() multiple times.
     ##
-    my $self = $_[0]->_get_self;
+    my $self = shift->_get_self;
 
     if (!defined($self->_fh)) { return; }
 
@@ -262,7 +261,7 @@ sub export {
     ##
     # Recursively export into standard Perl hashes and arrays.
     ##
-    my $self = $_[0]->_get_self;
+    my $self = shift->_get_self;
 
     my $temp;
     if ($self->_type eq TYPE_HASH) { $temp = {}; }
@@ -282,8 +281,8 @@ sub import {
     #XXX This use of ref() seems to be ok
     if (!ref($_[0])) { return; } # Perl calls import() on use -- ignore
 
-    my $self = $_[0]->_get_self;
-    my $struct = $_[1];
+    my $self = shift->_get_self;
+    my ($struct) = @_;
 
     #XXX This use of ref() seems to be ok
     if (!ref($struct)) {
@@ -315,7 +314,7 @@ sub optimize {
     # Rebuild entire database into new file, then move
     # it back on top of original.
     ##
-    my $self = $_[0]->_get_self;
+    my $self = shift->_get_self;
 
 #XXX Need to create a new test for this
 #    if ($self->_root->{links} > 1) {
@@ -373,7 +372,7 @@ sub clone {
     ##
     # Make copy of object and return
     ##
-    my $self = $_[0]->_get_self;
+    my $self = shift->_get_self;
 
     return DBM::Deep->new(
         type => $self->_type,
@@ -394,9 +393,9 @@ sub clone {
         ##
         # Setup filter function for storing or fetching the key or value
         ##
-        my $self = $_[0]->_get_self;
-        my $type = lc $_[1];
-        my $func = $_[2] ? $_[2] : undef;
+        my $self = shift->_get_self;
+        my $type = lc shift;
+        my $func = shift;
 
         if ( $is_legal_filter{$type} ) {
             $self->_root->{"filter_$type"} = $func;
@@ -419,14 +418,6 @@ sub _root {
     return $self->{root};
 }
 
-sub _fh {
-    ##
-    # Get access to the raw fh
-    ##
-    my $self = $_[0]->_get_self;
-    return $self->_root->{fh};
-}
-
 sub _type {
     ##
     # Get type of current node (TYPE_HASH or TYPE_ARRAY)
@@ -443,6 +434,14 @@ sub _base_offset {
     return $self->{base_offset};
 }
 
+sub _fh {
+    ##
+    # Get access to the raw fh
+    ##
+    my $self = $_[0]->_get_self;
+    return $self->_root->{fh};
+}
+
 ##
 # Utility methods
 ##

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 7a1a65c..72d0690 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -158,9 +158,12 @@ sub open {
         seek($fh, 0 + $obj->_root->{file_offset}, SEEK_SET);
         print( $fh SIG_FILE);
 
+        $obj->_root->{end} = length( SIG_FILE );
+
+        $obj->{base_offset} = $self->_request_space($obj, $self->{index_size});
+
         $self->create_tag(
-            $obj, $obj->_base_offset, $obj->_type,
-            chr(0) x $self->{index_size},
+            $obj, $obj->_base_offset, $obj->_type, chr(0) x $self->{index_size},
         );
 
         # Flush the filehandle
@@ -881,6 +884,22 @@ sub _find_in_buckets {
     return;
 }
 
+sub _request_space {
+    my $self = shift;
+    my ($obj, $size) = @_;
+
+    my $loc = $obj->_root->{end};
+
+    return $loc;
+}
+
+sub _release_space {
+    my $self = shift;
+    my ($obj, $size, $loc) = @_;
+
+    return;
+}
+
 1;
 __END__
 

diff --git a/t/04_array.t b/t/04_array.t
index f652ded..7529056 100644 (file)
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -201,5 +201,5 @@ is($returned[0], "middle ABC");
 
 $db->[0] = [ 1 .. 3 ];
 $db->[1] = { a => 'foo' };
-is( $db->[0]->length, 3, "Reuse of same space with array successful" );
 is( $db->[1]->fetch('a'), 'foo', "Reuse of same space with hash successful" );
+is( $db->[0]->length, 3, "Reuse of same space with array successful" );