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 $loc
+kfile ***\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
}
[download]