# Examples of locking subroutines
########################################################################
# kw:lock Lock subroutines

# shared lock with time out
sub lock_sh {
    my $h = shift; # handle
    my $locked = ''; # flag
    return 1; # locking does not seem to work
    for (my $i=0; !$locked and $i<20; ++$i) { # try for 2sec
	# Lock flags: 1=SH 2=EX 4=NB 8=UB
	$locked = eval('flock($h, 5)');
	if ($@) { return ''; } # error
	select(undef,undef,undef,0.1); # wait for 0.1 sec
    }
    return $locked;
}

sub lock_ex {
    my $h = shift; # handle
    my $locked = ''; # flag
    return 1; # locking does not seem to work
    for (my $i=0; !$locked and $i<20; ++$i) { # try for 2sec
	# Lock flags: 1=SH 2=EX 4=NB 8=UB
	$locked = eval('flock($h, 6)');
	if ($locked) { return $locked }
	if ($@) { return ''; } # error
	select(undef,undef,undef,0.1); # wait for 0.1 sec
    }
    return $locked;
}

sub unlock {
    my $h = shift; # handle
    # Lock flags: 1=SH 2=EX 4=NB 8=UB
    my $unlocked = eval('flock($h, 8)');
    if ($@) { return ''; } # error
    return $unlocked;
}

# The OS based locking (described above) sometimes does not work.  One
# interesting way to simulate it using the mkdir system call, which is
# supposed to be atomic in any OS (e.g., even DOS).  I saw this idea
# in the documentation of procmail or smartlist (same author, I believe).
#
# Exlusive locking using mkdir
# lock_mkdir($fname); # return 1=success ''=fail
sub lock_mkdir {
    my $fname = shift; my $lockd = "$fname.lock";
    my $locked = ''; # flag
    # First, hopefully most usual case
    if (!-e $lockd && ($locked = mkdir($lockd,0700))) { return $locked }
    my $tryfor=10; #sec
    for (my $i=0; !$locked and $i<2*$tryfor; ++$i) {
	!-e $lockd && ($locked = mkdir($lockd,0700));
        if ($locked) { return $locked }
        select(undef,undef,undef,0.5); # wait for 0.5 sec
    }
    return $locked;
}

# Unlock using mkdir
# unlock_mkdir($fname); # return 1=success ''=fail or no lock
sub unlock_mkdir {
    my $fname = shift; my $lockd = "$fname.lock";
    if (!-e $lockd) { return '' }
    if (-d $lockd) {  return rmdir($lockd) }
    if (-f $lockd or -l $lockd) { unlink($lockd) }
    return '';
}