From: rkinyon@cpan.org <rkinyon@cpan.org>
Date: Mon, 16 Jun 2008 01:41:57 +0000 (+0000)
Subject: Removed the need for the :flock constants from Fcntl in DBM/Deep.pm
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5c0756fcb3b5c7ca76c52be6c7c9d78841e5d57b;p=dbsrgits%2FDBM-Deep.git

Removed the need for the :flock constants from Fcntl in DBM/Deep.pm

git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@3578 88f4d9cd-8a04-0410-9d60-8f63309c3137
---

diff --git a/Changes b/Changes
index b7d0612..e627f61 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,10 @@ Revision history for DBM::Deep.
 1.0014 Jun 13 23:15:00 2008 EST
     - (This version is compatible with 1.0013)
     - Fix for RT#36781 (t/44 has an unrequired dependency)
+    - lock() has been aliased to lock_exclusive(). There is now
+      a lock_shared() method. The :flock constants are no longer
+      imported into the DBM::Deep namespace.
+      **** THIS IS AN API CHANGE ****
     - Start the process of optimization.
 
 1.0013 Jun 13 23:15:00 2008 EST
diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 6a02caa..d102d36 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -8,7 +8,6 @@ use warnings FATAL => 'all';
 our $VERSION = q(1.0014);
 
 use Data::Dumper ();
-use Fcntl qw( :flock );
 use Scalar::Util ();
 
 use DBM::Deep::Engine;
@@ -111,7 +110,7 @@ sub _init {
     eval {
       local $SIG{'__DIE__'};
 
-      $self->lock;
+      $self->lock_exclusive;
       $self->_engine->setup_fh( $self );
       $self->_storage->set_inode;
       $self->unlock;
@@ -136,14 +135,19 @@ sub TIEARRAY {
     return DBM::Deep::Array->TIEARRAY( @_ );
 }
 
-sub lock {
+sub lock_exclusive {
     my $self = shift->_get_self;
-    return $self->_storage->lock( $self, @_ );
+    return $self->_storage->lock_exclusive( $self );
+}
+*lock = \&lock_exclusive;
+sub lock_shared {
+    my $self = shift->_get_self;
+    return $self->_storage->lock_shared( $self );
 }
 
 sub unlock {
     my $self = shift->_get_self;
-    return $self->_storage->unlock( $self, @_ );
+    return $self->_storage->unlock( $self );
 }
 
 sub _copy_value {
@@ -203,9 +207,9 @@ sub export {
 
     my $temp = $self->_repr;
 
-    $self->lock();
+    $self->lock_exclusive;
     $self->_copy_node( $temp );
-    $self->unlock();
+    $self->unlock;
 
     my $classname = $self->_engine->get_classname( $self );
     if ( defined $classname ) {
@@ -325,7 +329,7 @@ sub optimize {
         )),
     );
 
-    $self->lock();
+    $self->lock_exclusive;
     $self->_engine->clear_cache;
     $self->_copy_node( $db_temp );
     $db_temp->_storage->close;
@@ -344,23 +348,23 @@ sub optimize {
         # before it is overwritten with rename().  This could be redone
         # with a soft copy.
         ##
-        $self->unlock();
+        $self->unlock;
         $self->_storage->close;
     }
 
     if (!rename $temp_filename, $self->_storage->{file}) {
         unlink $temp_filename;
-        $self->unlock();
+        $self->unlock;
         $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
     }
 
-    $self->unlock();
+    $self->unlock;
     $self->_storage->close;
 
     $self->_storage->open;
-    $self->lock();
+    $self->lock_exclusive;
     $self->_engine->setup_fh( $self );
-    $self->unlock();
+    $self->unlock;
 
     return 1;
 }
@@ -479,10 +483,7 @@ sub STORE {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
-    ##
-    # Request exclusive lock for writing
-    ##
-    $self->lock( LOCK_EX );
+    $self->lock_exclusive;
 
     # User may be storing a complex value, in which case we do not want it run
     # through the filtering system.
@@ -492,7 +493,7 @@ sub STORE {
 
     $self->_engine->write_value( $self, $key, $value);
 
-    $self->unlock();
+    $self->unlock;
 
     return 1;
 }
@@ -505,14 +506,11 @@ sub FETCH {
     my ($key) = @_;
     warn "FETCH($self,$key)\n" if DEBUG;
 
-    ##
-    # Request shared lock for reading
-    ##
-    $self->lock( LOCK_SH );
+    $self->lock_shared;
 
     my $result = $self->_engine->read_value( $self, $key);
 
-    $self->unlock();
+    $self->unlock;
 
     # 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.
@@ -533,10 +531,7 @@ sub DELETE {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
-    ##
-    # Request exclusive lock for writing
-    ##
-    $self->lock( LOCK_EX );
+    $self->lock_exclusive;
 
     ##
     # Delete bucket
@@ -547,7 +542,7 @@ sub DELETE {
         $value = $self->_storage->{filter_fetch_value}->($value);
     }
 
-    $self->unlock();
+    $self->unlock;
 
     return $value;
 }
@@ -560,14 +555,11 @@ sub EXISTS {
     my ($key) = @_;
     warn "EXISTS($self,$key)\n" if DEBUG;
 
-    ##
-    # Request shared lock for reading
-    ##
-    $self->lock( LOCK_SH );
+    $self->lock_shared;
 
     my $result = $self->_engine->key_exists( $self, $key );
 
-    $self->unlock();
+    $self->unlock;
 
     return $result;
 }
@@ -583,10 +575,7 @@ sub CLEAR {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
     }
 
-    ##
-    # Request exclusive lock for writing
-    ##
-    $self->lock( LOCK_EX );
+    $self->lock_exclusive;
 
     #XXX Rewrite this dreck to do it in the engine as a tight loop vs.
     # iterating over keys - such a WASTE - is this required for transactional
@@ -608,7 +597,7 @@ sub CLEAR {
         $self->STORESIZE( 0 );
     }
 
-    $self->unlock();
+    $self->unlock;
 
     return 1;
 }
diff --git a/lib/DBM/Deep.pod b/lib/DBM/Deep.pod
index 50aea5f..7252f7c 100644
--- a/lib/DBM/Deep.pod
+++ b/lib/DBM/Deep.pod
@@ -385,7 +385,7 @@ value.
 
   $db->clear(); # hashes or arrays
 
-=item * lock() / unlock()
+=item * lock_exclusive() / lock_shared() / lock() / unlock()
 
 q.v. L</LOCKING> for more info.
 
@@ -572,15 +572,8 @@ then incremented, then stored again.
   $db->{counter}++;
   $db->unlock();
 
-You can pass C<lock()> an optional argument, which specifies which mode to use
-(exclusive or shared). Use one of these two constants:
-C<DBM::Deep-E<gt>LOCK_EX> or C<DBM::Deep-E<gt>LOCK_SH>. These are passed
-directly to C<flock()>, and are the same as the constants defined in Perl's
-L<Fcntl> module.
-
-  $db->lock( $db->LOCK_SH );
-  # something here
-  $db->unlock();
+If you want a shared lock, you will need to call C<lock_shared()>. C<lock()> is
+an alias to C<lock_exclusive()>.
 
 =head2 Win32/Cygwin
 
diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 73babc5..c32d215 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -33,7 +33,7 @@ sub FETCH {
     my $self = shift->_get_self;
     my ($key) = @_;
 
-    $self->lock( $self->LOCK_SH );
+    $self->lock_shared;
 
     if ( !defined $key ) {
         $self->unlock;
@@ -64,7 +64,7 @@ sub STORE {
     my $self = shift->_get_self;
     my ($key, $value) = @_;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $size;
     my $idx_is_numeric;
@@ -105,7 +105,7 @@ sub EXISTS {
     my $self = shift->_get_self;
     my ($key) = @_;
 
-    $self->lock( $self->LOCK_SH );
+    $self->lock_shared;
 
     if ( !defined $key ) {
         $self->unlock;
@@ -137,7 +137,7 @@ sub DELETE {
     my ($key) = @_;
     warn "ARRAY::DELETE($self,$key)\n" if DBM::Deep::DEBUG;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $size = $self->FETCHSIZE;
     if ( !defined $key ) {
@@ -175,7 +175,7 @@ sub DELETE {
 sub FETCHSIZE {
     my $self = shift->_get_self;
 
-    $self->lock( $self->LOCK_SH );
+    $self->lock_shared;
 
     my $SAVE_FILTER = $self->_storage->{filter_fetch_value};
     $self->_storage->{filter_fetch_value} = undef;
@@ -193,7 +193,7 @@ sub STORESIZE {
     my $self = shift->_get_self;
     my ($new_length) = @_;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $SAVE_FILTER = $self->_storage->{filter_store_value};
     $self->_storage->{filter_store_value} = undef;
@@ -210,7 +210,7 @@ sub STORESIZE {
 sub POP {
     my $self = shift->_get_self;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $length = $self->FETCHSIZE();
 
@@ -231,7 +231,7 @@ sub POP {
 sub PUSH {
     my $self = shift->_get_self;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $length = $self->FETCHSIZE();
 
@@ -258,7 +258,7 @@ sub SHIFT {
     my $self = shift->_get_self;
     warn "SHIFT($self)\n" if DBM::Deep::DEBUG;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $length = $self->FETCHSIZE();
 
@@ -287,7 +287,7 @@ sub UNSHIFT {
     my $self = shift->_get_self;
     my @new_elements = @_;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $length = $self->FETCHSIZE();
     my $new_size = scalar @new_elements;
@@ -312,7 +312,7 @@ sub UNSHIFT {
 sub SPLICE {
     my $self = shift->_get_self;
 
-    $self->lock( $self->LOCK_EX );
+    $self->lock_exclusive;
 
     my $length = $self->FETCHSIZE();
 
diff --git a/lib/DBM/Deep/Engine/Sector/BucketList.pm b/lib/DBM/Deep/Engine/Sector/BucketList.pm
index dd2ece4..008aa1e 100644
--- a/lib/DBM/Deep/Engine/Sector/BucketList.pm
+++ b/lib/DBM/Deep/Engine/Sector/BucketList.pm
@@ -39,9 +39,8 @@ sub clear {
 sub size {
     my $self = shift;
     unless ( $self->{size} ) {
-        my $e = $self->engine;
         # Base + numbuckets * bucketsize
-        $self->{size} = $self->base_size + $e->max_buckets * $self->bucket_size;
+        $self->{size} = $self->base_size + $self->engine->max_buckets * $self->bucket_size;
     }
     return $self->{size};
 }
diff --git a/lib/DBM/Deep/Engine/Sector/Reference.pm b/lib/DBM/Deep/Engine/Sector/Reference.pm
index 2d1bff3..71a1eaf 100644
--- a/lib/DBM/Deep/Engine/Sector/Reference.pm
+++ b/lib/DBM/Deep/Engine/Sector/Reference.pm
@@ -331,6 +331,8 @@ sub get_bucket_list {
                     }),
                 });
             }
+
+#XXX Why is this code here? -RobK, 2008-06-15
 #            my $blist = $blist_cache{$idx}
 #                ||= DBM::Deep::Engine::Sector::BucketList->new({
 #                    engine => $engine,
diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 0a3096f..7974ef4 100644
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -168,6 +168,18 @@ sub request_space {
 # times before unlock(), then the same number of unlocks() must
 # be called before the lock is released.
 ##
+sub lock_exclusive {
+    my $self = shift;
+    my ($obj) = @_;
+    return $self->lock( $obj, LOCK_EX );
+}
+
+sub lock_shared {
+    my $self = shift;
+    my ($obj) = @_;
+    return $self->lock( $obj, LOCK_SH );
+}
+
 sub lock {
     my $self = shift;
     my ($obj, $type) = @_;
diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 43fd26a..6d81faf 100644
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -72,10 +72,7 @@ sub FIRSTKEY {
     ##
     my $self = shift->_get_self;
 
-    ##
-    # Request shared lock for reading
-    ##
-    $self->lock( $self->LOCK_SH );
+    $self->lock_shared;
     
     my $result = $self->_engine->get_next_key( $self );
     
@@ -96,10 +93,7 @@ sub NEXTKEY {
         ? $self->_storage->{filter_store_key}->($_[0])
         : $_[0];
 
-    ##
-    # Request shared lock for reading
-    ##
-    $self->lock( $self->LOCK_SH );
+    $self->lock_shared;
     
     my $result = $self->_engine->get_next_key( $self, $prev_key );
     
diff --git a/t/07_locking.t b/t/07_locking.t
index 004e03b..ca335fe 100644
--- a/t/07_locking.t
+++ b/t/07_locking.t
@@ -31,7 +31,7 @@ is( $db->{key2}[1], 2 );
 ##
 # explicit lock
 ##
-$db->lock( DBM::Deep->LOCK_EX );
+$db->lock_exclusive;
 $db->{key1} = "value2";
 $db->unlock();
 is( $db->{key1}, "value2", "key1 is overridden" );