PApp::Lock - manage locks using sql

PApp documentation Contained in the PApp distribution.

Index

Code Index:

NAME

Top

PApp::Lock - manage locks using sql

SYNOPSIS

Top

 use PApp::Lock;
 # not auto-imported into .papp-files

 locked {
    ... locked code section
 } "my_app_lock", 60, 60*10;

DESCRIPTION

Top

This module manages locking (semaphores) using the papp state database (i.e. it works without filesystem and across hosts).

locked BLOCK name, [timeout, [holdtime]]

Execute the given BLOCK while holding the lock NAME. The lock will be given up as soon as the block is left. See the new method for the meaning of the arguments.

$lock = new PApp::Lock name, [timeout, [holdtime]]

Create a new lock object (but do not lock it) of name name. The name might be used case-sensitive or -insensitive, so always use the same spel[l]ing but don't expect that lock names are case-sensitive. timeout specifies the maximum time that the program waits until the lock becomes available (default: 5 minutes). holdtime specifies the maximum age the lock can have (default: 12 hours). A lock older than holdtime is broken.

$ok = $lock->lock([timeout])

Tries to aquire the lock until the timeout is reached. Returns true when the lock was aquired and false when the lock couldn't be aquired.

See new for the meaning of timeout.

$lock->breaktime

Returns the time when the lock can be broken (by another application). This can be called even when the process does not hold the lock. If the lock is not used it will return nothing.

SEE ALSO

Top

PApp.

AUTHOR

Top

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/
PApp documentation Contained in the PApp distribution. 
##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH   ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE    ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn,            ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de.                                                  ##
##########################################################################


package PApp::Lock;

use PApp::Config;
use PApp::Exception;
use PApp::SQL;

use base Exporter;

$VERSION = 1.45;
@EXPORT = qw(locked);


sub locked(&@) {
   my $block = shift;
   $lock = new PApp::Lock @_;
   eval {
      local $SIG{__DIE__} = \&PApp::Exception::diehandler;
      $lock->lock or do {
         require POSIX;
         fancydie "unable to aquire lock", $lock->{name},
                  info => [ breaktime => "The lock expires ".
                            POSIX::strftime("%Y-%m-%d %H:%M:%S %z", localtime $lock->breaktime)],
                  info => [ timeout  => $lock->{timeout} ],
                  info => [ holdtime => $lock->{holdtime} ],
                ;
      };
      &$block;
   };
   {
      local $@;
      $lock->unlock;
   }
   die if $@;
}


sub new($@) {
   my $class    = shift;
   my $lock     = shift;
   my $timeout  = shift || 5*60;
   my $holdtime = shift || 12*60*60;
   bless {
      name => $lock,
      timeout => $timeout,
      holdtime => $holdtime,
   }, $class;
}


sub lock {
   my $self = shift;
   local $DBH = PApp::Config::DBH;

   return 1 if $self->{lock}++;

   return 1 if eval {
      local $SIG{__DIE__};
      sql_exec "insert into locks values (?, ?, ?)", $self->{name}, time, "";
   };

   my $timeout = shift || $self->{timeout};
   my $wait = 0.1;
   my $beg = time;

   for(;;) {
      $now = time;
      return 1 if eval {
         sql_exec "delete from locks where id = ? and breaktime < ?", $self->{name}, $now - $self->{holdtime};
         sql_exec "insert into locks values (?, ?, ?)", $self->{name}, $now, "";
      };

      if ($now >= $beg + $timeout) {
         $self->{lock} = 0;
         return ();
      }

      select undef, undef, undef, $wait;
      $wait *= 1.5;
      $wait = 1 if $wait > $timeout * 0.1;
   }
}


sub breaktime {
   my $self = shift;
   local $DBH = PApp::Config::DBH;

   sql_fetch "select breaktime from locks where id = ?", $self->{lock};
}

sub unlock {
   my $self = shift;
   local $DBH = PApp::Config::DBH;

   return if $self->{locked}--;

   sql_exec "delete from locks where id = ?", $self->{name};
}

sub DESTROY {
   $self->unlock while $self->{locked};
}