Perl trapping Ctrl-C with threads in bash - linux

Question

While I see how to have Perl trap Ctrl-C (sigint) in bash; I'm getting lost at why does it fail with threads; I'm trying the following script:
#!/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();
... and as soon as the SIGINT handler is set to anything else than the default (where Ctrl-C causes exit), it basically causes for the script to stop reacting on Ctrl-C any longer:
$ ./test.pl
thread: 1
^Cthread: 2
^C^Cthread: 3
^C^C^C^Cthread: 4
thread: 5
thread: 6
thread: 7
thread: 8
Terminated
... and I have to sudo killall perl in order to terminate the script.
There is a bit on threads and Ctrl-C in these links:
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?
... but I cannot say if it conclusively answers whether "capturing" Ctrl-C under perl in bash is definitely impossible?
Thanks in advance for any answers,
Cheers!
Ok, I think I got it (but I'm leaving the previous entry (below) for reference ...)
The trick turns out to be that, from the main SIGINT handler, one must signal the thread via kill - AND then thread also needs to have a separate SIGINT handler (from the first link in OP); AND instead of just join(), one needs to use the code in the 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";
I may be overkilling it with the $toexit there, but at least now this is the result:
$ ./test.pl
prejoin
thread: 1
thread: 2
thread: 3
^CThread exit
postjoin
Many thanks to all for the solution :)
Cheers!
Thanks to the suggestion by #mob for PERL_SIGNALS to unsafe (note, Perl 5.14 does not allow "internal" setting of $ENV{'PERL_SIGNALS'}), I'm getting somewhere - now Ctrl-C is detected - but it either terminates with a segfault, or with error:
#!/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";
With the comments as above, that code react with:
$ PERL_SIGNALS="unsafe" ./testloop06.pl
prejoin
thread: 1
thread: 2
thread: 3
^Cthread: 4
out
Segmentation fault
Result is the same if I add the following that uses Perl::Signals::Unsafe:
$mthr = threads->create(\&counter);
UNSAFE_SIGNALS {
$mthr->join();
};
Almost there, hopefully someone can chime in ... :)

Answer 1

Signal handlers are only called between Perl opcodes. Your code is blocked in $mthr->join();, so it never gets to handle the signal.
Possible solution:
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);
}
}