Lock File

[toniax]

I just want to say thanks to everyone . I am learning alot

Hello Everyone I use this snippet of code for creating a lock file. Does a better way exist to do this?
Much Thanks in advanced

 $stop = 0;
   while ($stop == 0) {
    if (-e "the.lock") {
        
        sleep(1);
    }
    else {
    
    
    open (FIL,">the.lock");
    close FIL;
    }    

more code

unlink("the.lock");

$stop = 1;

[eyepopslikeamosquito]

Yes, use flock. And strict, warnings and 3-argument open. Some sample locking code follows. Adjust according to your needs.

use strict;
use warnings;
use Fcntl ':flock';    # import LOCK_* constants

open(my $fhlock, '>', $somelockfile) or die "Error: open '$somelockfil
+e': $!";
 
# Note: process will block at this point until the lock is acquired.
flock($fhlock, LOCK_EX) or die "Error: flock '$somelockfile': $!";
 
# Lock is now held until $fhlock is closed.
# Note that even if this program crashes or is killed, $fhlock will
# be closed by the OS and the lock released.
# ...

# Release the lock simply by closing the file handle.
close $fhlock or die "Error: close '$somelockfile': $!";

[ikegami]

A lock that is not automatically freed on unplanned program exit and unplanned systems restart is dangerous. It creates the possibility of a situation where a lock is thought to be held but isn't.

Having to poll the lock is inefficient (to varying degree). It can also prevent fairness (i.e. one particular process could wait forever for a lock if scheduling benefits other processes).

And now you know why flock was recommended.

[philipbailey]

Use flock.

[McDarren]

Here is a technique that I picked up here at the monastery a few years back, and have been using ever since:

use Fcntl 'LOCK_EX', 'LOCK_NB';

unless (flock DATA, LOCK_EX | LOCK_NB) {
    $logger->fatal("Found duplicate script run. Stopping");
    exit;
}

__DATA__
This exists to allow the locking code at the beginning of the file to 
+work.
DO NOT REMOVE THESE LINES!

If I can find the original node, I'll update with a link to it.
Update: Found it. this node by adamk.

Cheers,
Darren

[eyepopslikeamosquito]

As discussed in Ensuring only one copy of a perl script is running at a time, be aware that this trick works on Unix (with advisory locking), but does not work on Windows (mandatory locking).

[JavaFan]

You actually don't need the latter two lines. Just having either __DATA__ or __END__ will do.

[Anonymous Monk]

The text after the __DATA__ is required. Without it, the program will stop working as soon as a coworker tries to improve the code. :P

[choocroot]

Your code is subject to race conditions. Given two processes P1 and P2 started at the same time, you could end up with this behaviour where both processes execute the exclusive section "more code" at the same time :

P1 check if "the.lock" exists -> no
P2 check if "the.lock" exists -> no
P1 create "the.lock" -> ok
P2 create "the.lock" -> ok
P1 do "more code"
P2 do "more code"

For proper locking you can use flock :

use Fcntl qw(:flock);

open(LOCK, ">>", "lock")
        or die "Error: could not open or create lock: $!";

print "Waiting for lock...\n";
flock(LOCK, LOCK_EX)
        or die "Error: could not get lock";
print "Got lock!\n";

print "Working exclusively...\n";
sleep(10);
print "Done.\n";

print "Release lock.\n";
flock(LOCK, LOCK_UN);
print "Done.\n";

close(LOCK);

The "lock" file does not need to be erased at the end of the script, but you should open it in append mode '>>' rather than in truncate mode '>'. That way, if someone malicious pre-create a "lock" file as a symlink to another file, you won't erase the content of that linked file.

[apl]

Minor nit.

while ($stop = 0) {

should be

while ($stop == 0) {

[superfrink]

One work around is to put the constant on the left in comparisons. The following will throw an error:

while (0 = $stop) {

There is some more discussion in What habits do you have to avoid introducing bugs?