use Fcntl ':flock';
use POSIX;
sub iso_time { POSIX::strftime ("%Y-%m-%d %H:%M:%S",localtime($_[0]||time)) }

sub OnDestroy::DESTROY { shift(@_)->() }

sub OnDestroyDo(&) { bless shift(@_),"OnDestroy" }


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";
    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 "Locking $lockfile : $lock_msg";
        print $FH $lock_msg;
        truncate($FH, tell($FH)) or die "Failed to truncate:$!";

        # if I remove this it doesnt work on my Win2k box
        flock($FH, LOCK_UN) or die "sharedlock: $!";
        # but if I leave it in then it seems like a race condition is possible.

        flock($FH, LOCK_SH|LOCK_NB) or die "sharedlock: $!";
        return OnDestroyDo {
                            print "\tFinished 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|LOCK_NB)) {
        ( $time, $process, $lname )=split /\|/,join "",<$FH>;
        print "\tLockfile $lockfile appears to be locked by Process #$process at $time\n"
            if $debug;
    } else {
        print "Failed to get lock on $lockfile, not sure why.\n";
    }
    return
}