From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Tue, 7 Mar 2006 18:54:34 +0000 (+0000)
Subject: Added dep on 5.6.0 and started breakout of request_space()/release_space()
X-Git-Tag: 0-99_01~74
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e06824f82b4edc6b50a46a7936fad78a9515a907;p=dbsrgits%2FDBM-Deep.git

Added dep on 5.6.0 and started breakout of request_space()/release_space()
---

diff --git a/Build.PL b/Build.PL
index dddb76b..7a6e249 100644
--- a/Build.PL
+++ b/Build.PL
@@ -6,6 +6,7 @@ my $build = Module::Build->new(
     module_name => 'DBM::Deep',
     license => 'perl',
     requires => {
+        perl           => '5.6.0',
         'Digest::MD5'  => '1.00',
         'Scalar::Util' => '1.14',
     },
diff --git a/Changes b/Changes
index 21b318e..716df29 100644
--- a/Changes
+++ b/Changes
@@ -1,7 +1,11 @@
 Revision history for DBM::Deep.
 
 0.99_01 ??? ?? ??;??:?? 2006 Pacific
+    - Provided explicit dependency on Perl 5.6.0
+      - Digest::MD5 requires 5.6.0
+      - Sub::Uplevel (dep of Test::Exception) requires 5.6.0
     - Removed error()/clear_error()
+    - Broke out DBM::Deep's code into DBM::Deep::Engine
 
 0.98  Feb 28 11:00:00 2006 Pacific
     - Added in patch by David Cantrell to allow use of DATA filehandle
diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 280585c..5b14412 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -43,9 +43,8 @@ $VERSION = q(0.99_01);
 ##
 # Setup constants for users to pass to new()
 ##
-sub TYPE_HASH   () { DBM::Deep::Engine::SIG_HASH   }
-sub TYPE_ARRAY  () { DBM::Deep::Engine::SIG_ARRAY  }
-sub TYPE_SCALAR () { DBM::Deep::Engine::SIG_SCALAR }
+sub TYPE_HASH   () { DBM::Deep::Engine->SIG_HASH   }
+sub TYPE_ARRAY  () { DBM::Deep::Engine->SIG_ARRAY  }
 
 sub _get_args {
     my $proto = shift;
@@ -108,8 +107,8 @@ sub _init {
     my $self = bless {
         type        => TYPE_HASH,
         engine      => DBM::Deep::Engine->new,
+        base_offset => undef,
     }, $class;
-    $self->{base_offset} = length( $self->{engine}->SIG_FILE );
 
     foreach my $param ( keys %$self ) {
         next unless exists $args->{$param};
@@ -319,9 +318,6 @@ sub optimize {
         file => $self->_root->{file} . '.tmp',
         type => $self->_type
     );
-    if (!$db_temp) {
-        $self->_throw_error("Cannot optimize: failed to open temp file: $!");
-    }
 
     $self->lock();
     $self->_copy_node( $db_temp );
@@ -495,7 +491,7 @@ sub FETCH {
     # Fetch single value or element given plain key or array index
     ##
     my $self = shift->_get_self;
-    my $key = shift;
+    my ($key) = @_;
 
     my $md5 = $self->{engine}{digest}->($key);
 
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 72d0690..d49e4e4 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -107,6 +107,9 @@ sub setup_fh {
 
     $self->open( $obj ) if !defined $obj->_fh;
 
+    $obj->{base_offset} = length( SIG_FILE )
+        unless defined $obj->{base_offset};
+
     #XXX We have to make sure we don't mess up when autoflush isn't turned on
     unless ( $obj->_root->{inode} ) {
         my @stats = stat($obj->_fh);
@@ -174,6 +177,9 @@ sub open {
         return 1;
     }
 
+    $obj->{base_offset} = $bytes_read
+        unless defined $obj->{base_offset};
+
     ##
     # Check signature was valid
     ##
@@ -242,6 +248,8 @@ sub load_tag {
     my $self = shift;
     my ($obj, $offset) = @_;
 
+#    print join(':',map{$_||''}caller(1)), $/;
+
     my $fh = $obj->_fh;
 
     seek($fh, $offset + $obj->_root->{file_offset}, SEEK_SET);
@@ -762,7 +770,11 @@ sub traverse_index {
         for (my $idx = $start; $idx < (2**8); $idx++) {
             my $subloc = unpack(
                 $self->{long_pack},
-                substr($content, $idx * $self->{long_size}, $self->{long_size}),
+                substr(
+                    $content,
+                    $idx * $self->{long_size},
+                    $self->{long_size},
+                ),
             );
 
             if ($subloc) {
diff --git a/t/11_optimize.t b/t/11_optimize.t
index b5876a5..27d2058 100644
--- a/t/11_optimize.t
+++ b/t/11_optimize.t
@@ -53,6 +53,8 @@ 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" );
 
+#print keys %{$db->{a}}, $/;
+
 ##
 # now for the tricky one -- try to store a new key while file is being
 # optimized and locked by another process.  filehandle should be invalidated, 
@@ -109,6 +111,13 @@ SKIP: {
     
     # see if it was stored successfully
     is( $db->{parentfork}, "hello", "stored key while optimize took place" );
+
+#    undef $db;
+#    $db = DBM::Deep->new(
+#        file => $filename,
+#        autoflush => 1,
+#        locking => 1
+#    );
     
     # now check some existing values from before
     is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
diff --git a/t/27_filehandle.t b/t/27_filehandle.t
index 5902879..dfb988e 100644
--- a/t/27_filehandle.t
+++ b/t/27_filehandle.t
@@ -28,7 +28,8 @@ my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
     ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database");
     throws_ok {
         $db->{foo} = 1;
-    } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
+    } qr/Cannot write to a readonly filehandle/,
+      "Can't write to a read-only filehandle";
     ok( !$db->exists( 'foo' ), "foo doesn't exist" );
 
     my $db_obj = $db->_get_self;