Как заставить perl блокировать файл в неблокирующем режиме в NFS

Question

fcntl в perl может блокироваться в NFS, режимом по умолчанию является режим блокировки. Как сделать это неблокирующим режимом? Я попробовал следующий код, но он не работает

sub lock_file {
    my ($lock_file, $block) = @_;
    return unless defined $lock_file;
    my $LOCKFH;
    if (file_exist($lock_file)) {
        sysopen($LOCKFH, "$lock_file", O_RDWR) || return undef;
    } else {
        sysopen($LOCKFH, "$lock_file", O_RDWR|O_CREAT|O_EXCL) || return undef;
    }
    my $lock_ret = 0;
    my $pack;
    if ($block) {
        my $flags;
        fcntl($LOCKFH, F_GETFL, $flags);
        $flags &= !O_NONBLOCK;
        my $fail_block = fcntl($LOCKFH, F_SETFL, $flags);
        print "failed to set the lock to block mode.$!\n" if !$fail_block;
    }
    $pack = pack('ssqql', F_WRLCK, SEEK_SET, 0, 0, 0);
    $lock_ret = fcntl($LOCKFH, F_SETLK, $pack);
    if (!$lock_ret) {
        close $LOCKFH;
        return undef;
    }
    return $LOCKFH;
}

Answer 1

Попробуйте использовать flock с LOCK_NB, например

use Fcntl qw(:DEFAULT :flock);
flock( $fh, LOCK_EX|LOCK_NB ) or die "failed to get lock";
... do code while having the lock ...
flock( $fh, LOCK_UN);

Кроме того, я помню из старых времен, что блокировка с NFS всегда была немного особенной и не всегда делала то, что вы ожидали. Вот почему были специальные схемы блокировки, использующие вспомогательные файлы, когда почтовые ящики распределялись по NFS. Я не уверен, относится ли это к текущим реализациям NFS.