Perl 在 bash 中使用线程捕获 Ctrl-C

Question

虽然我知道如何拥有Perl trap Ctrl-C (sigint) in bash;我迷失了为什么它会因线程而失败；我正在尝试以下脚本：

#!/usr/bin/env perl

use threads;
use threads::shared; # for shared variables

my $cnt :shared = 0;

sub counter() {
  while (1) {
    $cnt++;
    print "thread: $cnt \n";
    sleep 1;
  }
}

sub finisher{
  ### Thread exit! ...
  print "IIII";
  threads->exit();
  die;
};

# any of these will cause stop of reaction to Ctrl-C
$SIG{INT} = \&finisher;
$SIG{INT} = sub {print "EEE\n" ;} ;
$SIG{INT} = 'IGNORE';

# setting to DEFAULT, brings usual behavior back
#~ $SIG{INT} = 'DEFAULT';

my $mthr = threads->create(\&counter);
$mthr->join();

...一旦 SIGINT 处理程序设置为默认值以外的任何其他值（Ctrl-C 导致退出），它基本上会导致脚本停止对 Ctrl-C 做出反应不再：

$ ./test.pl 
thread: 1 
^Cthread: 2 
^C^Cthread: 3 
^C^C^C^Cthread: 4 
thread: 5 
thread: 6 
thread: 7 
thread: 8 
Terminated

...我必须sudo killall perl 才能终止脚本。

这些链接中有一些关于线程和 Ctrl-C 的内容：

• Sending sig INT ( control C ) to threads - Dev Shed
• SOLVED: Is this a bug of perl threads ? - Perl Monks
• How do we capture CTRL ^ C - Perl Monks
• Is the signal handler supposed to work like this?

...但我不能说它是否最终回答了在 bash 中的 perl 下“捕获”Ctrl-C 是否绝对不可能？

提前感谢您的任何回答，
干杯！

---

好的，我想我明白了（但我将之前的条目（如下）留作参考......）

事实证明，从主 SIGINT 处理程序开始，必须通过kill 向线程发出信号 - 然后线程还需要有一个单独的 SIGINT 处理程序（来自 OP 中的第一个链接）；并且不仅仅是join()，还需要使用answer by @ikegami中的代码：

#!/usr/bin/env perl

use threads;
use threads::shared; # for shared variables

my $cnt :shared = 0;
my $toexit :shared = 0;


sub counter() {
  $SIG{'INT'} = sub { print "Thread exit\n"; threads->exit(); };
  my $lexit = 0;
  while (not($lexit)) {
    { lock($toexit);
    $lexit = $toexit;
    }
    $cnt++;
    print "thread: $cnt \n";
    sleep 1;
  }
  print "out\n";
}

my $mthr;

sub finisher{
  { lock($toexit);
  $toexit = 1;
  }
  $mthr->kill('INT');
};

$SIG{INT} = \&finisher;

$mthr = threads->create(\&counter);


print "prejoin\n";
#~ $mthr->join();

while (threads->list()) {
   my @joinable = threads->list(threads::joinable);
   if (@joinable) {
      $_->join for @joinable;
   } else {
      sleep(0.050);
   }
}
print "postjoin\n";

我可能用那里的$toexit 过度杀戮它，但至少现在这是结果：

$ ./test.pl
prejoin
thread: 1 
thread: 2 
thread: 3 
^CThread exit
postjoin

非常感谢大家的解决方案:)
干杯！

 

---

感谢@mob 对PERL_SIGNALS 到unsafe 的建议（注意，Perl 5.14 does not allow "internal" setting of $ENV{'PERL_SIGNALS'}），我已经到了某个地方 - 现在检测到 Ctrl-C - 但它要么终止有段错误，或者有错误：

#!/usr/bin/env perl

use threads;
use threads::shared; # for shared variables

my $cnt :shared = 0;
my $toexit :shared = 0;

sub counter() {
  my $lexit = 0;
  while (not($lexit)) {
    { lock($toexit);
    $lexit = $toexit;
    }
    $cnt++;
    print "thread: $cnt \n";
    sleep 1;
  }
  print "out\n";
  #~ threads->detach(); # Thread 1 terminated abnormally: Cannot detach a joined thread
  #~ exit;
}

my $mthr;

# [http://code.activestate.com/lists/perl5-porters/164923/ [perl #92246] Perl 5.14 does not allow "internal" setting of $ENV ...]
sub finisher{
  ### Thread exit! ...
  #~ print "IIII";
  # anything here results with: Perl exited with active threads:
  #~ threads->exit();
  #~ threads->join();
  #~ $mthr->exit();
  #~ $mthr->join();
  #~ $mthr->detach();
  #~ $mthr->kill();
  #~ threads->exit() if threads->can('exit');   # Thread friendly
  #~ die;
  { lock($toexit);
  $toexit = 1;
  }
  #~ threads->join(); #
};




# any of these will cause stop of reaction to Ctrl-C
$SIG{INT} = \&finisher;
#~ $SIG{INT} = sub {print "EEE\n" ; die; } ;
#~ $SIG{INT} = 'IGNORE';

# setting to DEFAULT, brings usual behavior back
#~ $SIG{INT} = 'DEFAULT';

$mthr = threads->create(\&counter);
print "prejoin\n";
$mthr->join();
print "postjoin\n";

使用上面的 cmets，该代码的反应是：

$ PERL_SIGNALS="unsafe" ./testloop06.pl
prejoin
thread: 1 
thread: 2 
thread: 3 
^Cthread: 4 
out
Segmentation fault

如果我添加使用Perl::Signals::Unsafe的以下内容，结果是相同的：

$mthr = threads->create(\&counter);

UNSAFE_SIGNALS {
  $mthr->join();
};

差不多了，希望有人能插话……:)

Answer 1

仅在 Perl 操作码之间调用信号处理程序。您的代码在$mthr->join(); 中被阻止，因此它永远无法处理信号。

可能的解决方案：

use Time::HiRes qw( sleep );

# Interruptable << $_->join() for threads->list; >>
while (threads->list()) {
   my @joinable = threads->list(threads::joinable);
   if (@joinable) {
      $_->join for @joinable;
   } else {
      sleep(0.050);
   }
}