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
our $VERSION = q(1.0014);
use Data::Dumper ();
-use Fcntl qw( :flock );
use Scalar::Util ();
use DBM::Deep::Engine;
eval {
local $SIG{'__DIE__'};
- $self->lock;
+ $self->lock_exclusive;
$self->_engine->setup_fh( $self );
$self->_storage->set_inode;
$self->unlock;
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 {
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 ) {
)),
);
- $self->lock();
+ $self->lock_exclusive;
$self->_engine->clear_cache;
$self->_copy_node( $db_temp );
$db_temp->_storage->close;
# 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;
}
$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.
$self->_engine->write_value( $self, $key, $value);
- $self->unlock();
+ $self->unlock;
return 1;
}
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.
$self->_throw_error( 'Cannot write to a readonly filehandle' );
}
- ##
- # Request exclusive lock for writing
- ##
- $self->lock( LOCK_EX );
+ $self->lock_exclusive;
##
# Delete bucket
$value = $self->_storage->{filter_fetch_value}->($value);
}
- $self->unlock();
+ $self->unlock;
return $value;
}
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;
}
$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
$self->STORESIZE( 0 );
}
- $self->unlock();
+ $self->unlock;
return 1;
}
$db->clear(); # hashes or arrays
-=item * lock() / unlock()
+=item * lock_exclusive() / lock_shared() / lock() / unlock()
q.v. L</LOCKING> for more info.
$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
my $self = shift->_get_self;
my ($key) = @_;
- $self->lock( $self->LOCK_SH );
+ $self->lock_shared;
if ( !defined $key ) {
$self->unlock;
my $self = shift->_get_self;
my ($key, $value) = @_;
- $self->lock( $self->LOCK_EX );
+ $self->lock_exclusive;
my $size;
my $idx_is_numeric;
my $self = shift->_get_self;
my ($key) = @_;
- $self->lock( $self->LOCK_SH );
+ $self->lock_shared;
if ( !defined $key ) {
$self->unlock;
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 ) {
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;
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;
sub POP {
my $self = shift->_get_self;
- $self->lock( $self->LOCK_EX );
+ $self->lock_exclusive;
my $length = $self->FETCHSIZE();
sub PUSH {
my $self = shift->_get_self;
- $self->lock( $self->LOCK_EX );
+ $self->lock_exclusive;
my $length = $self->FETCHSIZE();
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();
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;
sub SPLICE {
my $self = shift->_get_self;
- $self->lock( $self->LOCK_EX );
+ $self->lock_exclusive;
my $length = $self->FETCHSIZE();
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};
}
}),
});
}
+
+#XXX Why is this code here? -RobK, 2008-06-15
# my $blist = $blist_cache{$idx}
# ||= DBM::Deep::Engine::Sector::BucketList->new({
# engine => $engine,
# 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) = @_;
##
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 );
? $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 );
##
# explicit lock
##
-$db->lock( DBM::Deep->LOCK_EX );
+$db->lock_exclusive;
$db->{key1} = "value2";
$db->unlock();
is( $db->{key1}, "value2", "key1 is overridden" );