#!/usr/bin/perl - w use strict; # test case on ActivePerl 5.10 under WinXP $|++; #turns off stdout buffering #good for testing but a big performance #penalty use Fcntl qw (:flock); $SIG{INT} = \&release_lock; $SIG{QUIT} = \&release_lock; my $lock_file = "$0.lck"; #this next open will succeed if you have w permission... #even if you you don't have the lock yet or lock file #doesn't exist yet.. open LOCKFILE, ">>$lock_file" || die "Cannot open $lock_file"; my $got_lock =flock(LOCKFILE, LOCK_EX | LOCK_NB); if ($got_lock) { print "lock acquired\n"; foreach (1..10) { print "Locked..doing something..$_ seconds\n"; sleep(1); } } else { print STDERR "could not acquire lock\n"; exit(1); } print "Finished...Normal Exit, releasing lock\n"; close LOCKFILE || die "Cannot close $lock_file"; unlink $lock_file || die "Internal program error"; exit(0); #not needed but this is normal close sub release_lock { print STDERR "Abnormal exit...releasing lock\n"; close LOCKFILE || die "Cannot close $lock_file"; unlink $lock_file || die "Internal program error"; exit(2); }