sub get_lock { my ($lock_dir,$name)=@_; my $debug=1; $name=~s/[^-\w.#!\@~=+%\$]//g; my $lockfile=catfile($lock_dir,$name.'.lock'); print "Trying lockfile $lockfile\n"; if (-e $lockfile and (time()- -M $lockfile)<3) { print "\tLockfile exists and is very recent skipping for now\n"; return; } sysopen(my $FH, $lockfile, O_RDWR | O_CREAT) or do { warn "can't open $lockfile: $!" if $debug; return; }; # autoflush $FH select( (select($FH), $|++)[0] ); my ( $time, $process, $lname ); if (flock( $FH, LOCK_EX | LOCK_NB )) { ( $time, $process, $lname )=split /\|/,join "",<$FH>; seek $FH, 0, 0 or die "Failed rewind:$!"; if ($debug) { if ($process) { print "\tLockfile appears to be abandonded by Process #$process started at $time\n" } else { print "\tLockfile appears to be unprocessed\n" } } my $lock_msg=join("|", iso_time(), $$, $name)."\n"; print $FH $lock_msg; truncate($FH, tell($FH)) or die "Failed to truncate:$!"; flock($FH, LOCK_UN) or die "sharedlock: $!"; flock($FH, LOCK_SH|LOCK_NB) or do { print "\tFailed to relock!\n" if $debug; return; }; seek $FH, 0, 0 or die "Failed rewind2:$!"; my $msg=<$FH>; unless ($msg eq $lock_msg) { print "\tWhoops, (harmless) race condition on $lockfile!\n"; return } print "File Locked! : $lock_msg"; return OnDestroy { print "*** Finished with and removing $lockfile ***\n"; close $FH or die "Failed to close \$FH:$!"; unlink $lockfile or die "Failed to unlink $lockfile\n"; undef $FH; }; } elsif (flock($FH, LOCK_SH)) { ( $time, $process, $lname )=split /\|/,join "",<$FH>; print "\tLockfile appears to be locked by Process #$process at $time\n" if $debug; } else { print "\tFailed to get lock! Not sure why.\n"; } return }