performance tweak, added ref() check before eval {} block.

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep.pm

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 6eb9540..6c332cb 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -279,7 +279,9 @@ sub _open {
         return $self->_throw_error("Signature not found -- file is not a Deep DB");
     }
 
-    $self->root->{end} = (stat($fh))[7];
+       my @stats = stat($fh);
+       $self->root->{inode} = $stats[1];
+    $self->root->{end} = $stats[7];
         
     ##
     # Get our type from master index signature
@@ -386,7 +388,10 @@ sub _add_bucket {
        my $location = 0;
        my $result = 2;
 
-    my $is_dbm_deep = eval { $value->isa( 'DBM::Deep' ) };
+       # added ref() check first to avoid eval and runtime exception for every
+       # scalar value being stored.  performance tweak.
+    my $is_dbm_deep = ref($value) && eval { $value->isa( 'DBM::Deep' ) };
+    
        my $internal_ref = $is_dbm_deep && ($value->root eq $self->root);
 
     my $fh = $self->fh;
@@ -919,7 +924,16 @@ sub lock {
        if (!defined($self->fh)) { return; }
 
        if ($self->root->{locking}) {
-               if (!$self->root->{locked}) { flock($self->fh, $type); }
+               if (!$self->root->{locked}) {
+                       flock($self->fh, $type);
+                       
+                       # double-check file inode, in case another process
+                       # has optimize()d our file while we were waiting.
+                       if ((stat($self->root->{file}))[1] != $self->root->{inode}) {
+                               $self->_open(); # re-open
+                               flock($self->fh, $type); # re-lock
+                       }
+               }
                $self->root->{locked}++;
 
         return 1;
@@ -1269,9 +1283,8 @@ sub STORE {
     my $self = $_[0]->_get_self;
        my $key = $_[1];
 
-    #XXX What is ref() checking here?
-    #YYY User may be storing a hash, in which case we do not want it run 
-    #YYY through the filtering system
+    # User may be storing a hash, in which case we do not want it run 
+    # through the filtering system
        my $value = ($self->root->{filter_store_value} && !ref($_[2]))
         ? $self->root->{filter_store_value}->($_[2])
         : $_[2];
@@ -1285,13 +1298,13 @@ sub STORE {
                return;
        }
        ##
-
-    my $fh = $self->fh;
        
        ##
        # Request exclusive lock for writing
        ##
        $self->lock( LOCK_EX );
+       
+       my $fh = $self->fh;
 
        ##
        # If locking is enabled, set 'end' parameter again, in case another
@@ -1375,6 +1388,8 @@ sub FETCH {
        $self->unlock();
        
     #XXX What is ref() checking here?
+    #YYY Filters only apply on scalar values, so the ref check is making
+    #YYY 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)
         : $result;
@@ -1737,7 +1752,8 @@ filehandle.  Note: Beware of using the magick *DATA handle, as this actually
 contains your entire Perl script, as well as the data following the __DATA__
 marker.  This will not work, because DBM::Deep uses absolute seek()s into the
 file.  Instead, consider reading *DATA into an IO::Scalar handle, then passing
-in that.
+in that.  Also please note optimize() will NOT work when passing in only a
+handle.  Pass in a real filename in order to use optimize().
 
 =back
 
@@ -2684,9 +2700,10 @@ blib/lib/DBM/Deep/Hash.pm      95.2   80.0  100.0  100.0    n/a    4.4   92.3
 Total                          94.8   83.2   76.5   97.6   25.9  100.0   89.7
 ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Joseph Huckaby, L<jhuckaby@cpan.org>
+Rob Kinyon, L<rkinyon@cpan.org>
 
 Special thanks to Adam Sah and Rich Gaushell!  You know why :-)
 
@@ -2697,7 +2714,7 @@ Digest::SHA256(3), Crypt::Blowfish(3), Compress::Zlib(3)
 
 =head1 LICENSE
 
-Copyright (c) 2002-2005 Joseph Huckaby.  All Rights Reserved.
+Copyright (c) 2002-2006 Joseph Huckaby.  All Rights Reserved.
 This is free software, you may use it and distribute it under the
 same terms as Perl itself.