Simple Process Locking In Perl

My co-work Rick asked for a simple process lock control in Perl that would work over a server load balanced pool with a common NFS share. The easiest way is a loop that tries to create a directory, if the command fails then it waits and tries again, if the command succeeds then it has the lock and can do it's job. When done it removes the directory and another process gets to continue.

We started to build in an extra step so that if the script dies during the "meat and potatoes" section anther process can check if the PID from the previous process is still running and if not remove it. We did not get that far, I will let you figure the rest out.

The first usleep command is just to prevent process hammering, you should set it to match your expected time for a process to run. The second usleep is to simulate process congestion and is only for testing, you should remove it from your project.

#!/usr/bin/perl -w

use Time::HiRes qw(usleep nanosleep);

my $COUNTER=0;
my $dir = "/mnt/share/templock.dir";

while (! mkdir($dir) )
{
 $COUNTER++; 
 usleep(100);

 printf ("$$ waiting: $COUNTER\n");
 if ($COUNTER > 1000)
 {
  #open(my $fh, "<", $dir/PID");
  #my $row = <$fh>;
  
  die("squak\n");
 }
}

open(my $fh, ">", "$dir/PID");
printf $fh "$$\n";
close($fh);

#meat and potatoes
usleep(10000);


unlink("$dir/PID");
rmdir($dir);