如何使perl在NFS中以非阻塞模式锁定文件答案

【问题标题】：How to make perl lock a file with non-blocking mode in NFS如何使perl在NFS中以非阻塞模式锁定文件
【发布时间】：2014-07-02 14:57:37
【问题描述】：

perl 中的fcntl 可以锁定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;
}

【问题讨论】：

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; } 写sysopen($LOCKFH, "$lock_file", O_RDWR|O_CREAT) || return undef; 的方式不是很长而且不可靠吗？

标签： linux perl nfs

【解决方案1】：

尝试使用带有LOCK_NB的flock，例如

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 实现。

【讨论】：

如果perl -V:'d_fcntl(_can_lock)?' 对这两个值都显示define，则使用fcntl(2) 代替flock(2)，并且fcntl(2) 可以可靠地锁定NFS。