Перехват Perl Ctrl-C с потоками в Bash - PullRequest
Новая
       16

Перехват Perl Ctrl-C с потоками в Bash

4 голосов
/ 24 сентября 2011

Пока я вижу, как получить Perl-ловушка Ctrl-C (sigint) в 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:

... но я не могу сказать, дает ли он окончательный ответ, действительно ли невозможно "захватить" Ctrl-C под perl в bash?

Заранее спасибо за любые ответы,
Ура!

Хорошо, я думаю, что получил (, но я оставляю предыдущую запись (ниже) для справки ... )

Хитрость заключается в том, что от основного обработчика SIGINT нужно сигнализировать потоку через kill - И тогда поток также должен иметь отдельный обработчик SIGINT (от первой ссылки в OP); И вместо 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

Большое спасибо всем за решение :) 1055 * Ура!

Благодаря предложению @mob для PERL_SIGNALS до unsafe ( note, Perl 5.14 не допускает "внутреннюю" установку $ ENV {'PERL_SIGNALS'} ), Я где-то получаю - теперь Ctrl-C обнаружен - но он либо завершается с segfault, либо с ошибкой: 

#!/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();
};

Почти там, надеюсь, кто-то сможет подключиться ... :)

1 Ответ

5 голосов
/ 24 сентября 2011

Обработчики сигналов вызываются только между кодами операций 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);
   }
}
...