Perl使用bash中的線程捕獲Ctrl-C

Question

雖然我看到如何在bash中使用Perl陷阱Ctrl-C（sigint） ; 我迷失了為什么它會因為線程而失敗; 我正在嘗試以下腳本：

#!/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：

• 將sig INT（控制C）發送到線程 - Dev Shed
• 已解決：這是perl線程的錯誤嗎？ - Perl Monks
• 我們如何捕獲CTRL ^ C - Perl Monks
• 信號處理程序應該像這樣工作嗎？

...但我不能說它是否能最終回答在bash中“perl”下的“捕獲”Ctrl-C是否絕對不可能？

提前感謝您的任何答案，
干杯!

---

好吧，我想我得到了（ 但我要離開前面的條目（下面）作為參考...... ）

訣竅是，從主SIGINT處理程序，必須通過kill發出信號 - 然后線程還需要一個單獨的SIGINT處理程序（來自OP中的第一個鏈接）; AND而不只是join() ，需要在@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

非常感謝大家的解決方案:)
干杯!

---

), I'm getting somewhere - now Ctrl-C is detected - but it either terminates with a segfault, or with error: 感謝@mob對PERL_SIGNALS的建議unsafe （ ），我正在某處 - 現在檢測到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";

通過上面的評論，該代碼作出反應：

$ 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();被阻止$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);
   }
}