Software row locking

[prev] [thread] [next] [Date index for 2005/04/30]

Hi there !

I had a problem.
On some conditions my app (mod_perl1/mysql)
needed to apply complex update to a record and
make sure no one can read the record during the update.

I was using mysql's LOCK TABLES, but it seemed to be wrong solution.
In order to get things work, I needed to lock 10+ tables
(in different cases they are different, I'm bored with missing LOCKS),
some of them are searched/used heavily by the other parts of the app.
So I come to a app-side locking scheme,
which won't LOCK TABLES and queue locks in FIFO stack and
is suitable for mod_perl1.

Here are the questions
1. is it needed at all ? Should I better stick with lock tables ?
2. is there any (better) alternative. I failed to find one :(
3. is the SIGALRM the right signal to use in this situation (mostly to
break sleep)
4. Might anyone else need that code ? I could release it to CPAN,
if some of you consider it useful and point me to the right way of using
Test::More with the fork(). The code is quite generic and merely related
to Class::DBI,
so 'Class::DBI::Lock' isn't the right name I suppose.

Any thoughts are appreciated.

the code follows:

package Class::DBI::Lock;

use strict;
use warnings;

use base qw(Class::DBI);
use IPC::ShareLite qw(:lock);
use IPC::Signal qw(sig_num);
use Storable qw(freeze thaw);

our $VERSION = 0.01;
our $SHARE = new IPC::ShareLite(-key     => 'CDBI',
                                -create  => 1,
                                -destroy => 0);

__PACKAGE__->_store({});

sub lock {
    my ($class, $id, $timeout) = @_;

    die (__PACKAGE__ . "::lock() is a class method")
        if ref $class;

    my $sigalrm = 0;
    local $SIG{ALRM} = sub { $sigalrm++ };

    my $key = $class . $id;

    # locking the share
    $class->_lock();

    my $data = $class->_fetch();
    $data->{$key} ||= [];

    push @{ $data->{$key} }, $$;
    $class->_store($data);

    # unlocking the share
    # it is safe now to read from it
    $class->_unlock();

    # if it is first record in the queue
    # then return immidiately
    return 1 if @{ $data->{$key} } == 1;

    # waiting for lock release
    # which should come as SIGALRM
    sleep $timeout;
   
    # returning 1, since SIGALRM means lock is acquired
    return 1 if $sigalrm;
   
    # in case the lock timed out
    # need to remove our pid from the queue
    $class->_lock();
   
    $data = $class->_fetch();
    @{ $data->{$key} } = grep $_ != $$, @{ $data->{$key} };
    $class->_store($data);
   
    $class->_unlock();
   
    return 0;
}

sub unlock {
    my ($class, $id) = @_;

    my $key  = $class . $id;

    $class->_lock();
    my $data = $class->_fetch();

    if ($data->{$key}[0] == $$) {
        my $pid  = shift @{ $data->{$key} };
        $class->_store($data);
        $class->_unlock();

        kill(sig_num('ALRM'), $data->{$key}[0])
            if $data->{$key}[0];
    } else {
        warn "Calling unlock() without lock()";
        $class->_unlock();
    }
}

sub _lock   { $SHARE->lock( LOCK_EX ) }
sub _unlock { $SHARE->unlock() }
sub _store  { $SHARE->store( freeze($_[1])) }
sub _fetch  { thaw $SHARE->fetch() }

1;