Multithreading 锁定Perl子例程

我写了一个CGI脚本。它的一个子例程不能同时执行。i、 e.同一用户（或黑客）同时运行两个实例）。我怎样才能避免这种情况

我在使用锁文件方面做了以下工作，但我不确定它是否安全：

unless (-e $filelock) {
    sub_that_should_be_locked();
}


sub sub_that_should_be_locked {
    open FILE, ">", $filelock;
    flock DATAFILE, LOCK_EX;
    close FILE;

    ...Code that cannot be executed at the same time...   
    ...Code that cannot be executed at the same time...

    unlink $filelock;
}

---

不应存在等待/队列，并发进程决不应调用应锁定的子线程

要同步的线程不应创建和删除锁定文件

您应该确保该文件在线程启动之前存在，然后子例程应该使用词法文件句柄打开锁文件进行输入

像这样

open my $lock_fh, '<', $lockfile or die $!;
flock $lock_fh, LOCK_EX;

---

打开我的$lock\u fh，不安全。由于
-e
和
打开
之间存在时间，因此代码中存在竞争条件。不要将
-e
用于锁定文件

检查文件是否已锁定，而不是检查文件是否存在。这是使用非阻塞
flock
完成的。如果文件尚未锁定，它将返回success；如果文件已锁定，它将返回error
ewoodblock

请注意，要使其工作，您必须在\u应该\u锁定的
sub\u执行的整个时间内保持锁定。（您的代码一获得它就将其释放。）

这仍然容易受到比赛条件的影响。如果两个线程同时到达您的
行，除非
行，否则这两个线程都将在错误的假设下愉快地继续运行。@ikegami说过，您希望“避免调用
sub\u，即应该完全锁定
”。是吗？是的，“sub_that_be_锁定”不应该同时运行/调用，因为如果“sub_that_be_锁定”同时运行，这是一个获取货币余额并减去所有资金的例行程序，货币余额将变为负值，而不是我希望的0。我们都知道它不应该在多个进程中同时运行。问题是：如果两个进程试图同时运行它，会发生什么？第二个进程是否应跳过调用应锁定的子进程，或者第二个进程是否应等待第一个进程退出应锁定的子进程，第二个进程应跳过调用应锁定的子进程，因为一小部分秒也可能会导致问题，因为余额可能不会快速更新，这不符合OP的要求，因为如果其他人持有锁，它会阻塞。//另外，期望锁文件已经存在是一个不必要的限制，它会阻止你将锁文件放在
/tmp
@ikegami：我不太愿意回应，因为你在评论对话中往往会跳起欢快的舞蹈，但这与OP的说法有什么相反？如果有人持有锁，他不想阻止；相反，他希望避免调用
sub\u，认为应该完全锁定
。这就是
-e
检查的目的，他也明确地说明了这一点。@ikegami:我认为您的解决方案应该从描述问题开始，它正在回答PS-注意，我避免使用全局变量作为文件句柄（
打开我的$fh
而不是
打开文件
）。尽可能避免使用全局变量。最终结果是什么？所有应锁定的对sub_的并发调用都将被拒绝？除了第一个，所有的都会被拒绝？还是别的什么？我有点困惑，我熟悉perl，但不熟悉flock/linuxinternals@user3518089，与您的代码一样，第二个进程只是避免调用
sub\u，即如果某个进程已经在执行它，则应该锁定它。就像你问的，它不会等。如果你有不同的结果，请告诉我（编辑你的问题并在这里留下评论说你编辑了你的问题）。@user3518089，放置
sleep 15
在
sub\u中，您应该被锁定，并且应该很容易看到发生了什么。我猜您忘了使用Fcntl qw（LOCK\u EX LOCK\u NB）。如果是这样，那也意味着你忘记了使用strict；使用警告（您应该一直这么做），因为他们会更快地发现错误。
use Fcntl qw( LOCK_EX LOCK_NB );

sub get_lock_nb {
   my ($qfn) = @_;

   open(my $fh, '+>:raw', $qfn)
      or die("Unable to open file \"$qfn\": $!\n");

   if (!flock($fh, LOCK_EX | LOCK_NB)) {
      return undef if $!{EWOULDBLOCK};
      die("Unable to lock file \"$qfn\": $!\n");
   }

   return $fh;
}

sub sub_that_should_be_locked {
   ... Mutually exclusive code ...
}

{
   my $lock = get_lock_nb("file.lock");
   sub_that_should_be_locked() if $lock;
}