Perl and curses library - exit from a child thread - multithreading

Question

sub worker {
# Curse stuff
initscr();
cbreak();
noecho();
my $fh = FileHandle->new;
open $fh, q{-|},
"$myexe #pre_args make #after_args 2>&1"
or croak 'Cannot open';
process_output($fh);
my $err = close $fh;
endwin();
return;
}
sub process_output {
my ($fh) = #_;
while (my $line = <$fh>) {
#do stuff
}
}
ReadMode 3;
threads->create(\&worker);
while (threads->list(threads::running)) {
my $char = ReadKey -1, *STDIN;
if ($char) {
if ($char eq 'q') {
endwin();
kill('INT', $$);
threads->exit();
}
}
}
ReadMode 0;
foreach my $thr (threads->list) {
$thr->join();
When I press 'q':
Perl exited with active threads:
1 running and unjoined
0 finished and unjoined
0 running and detached
and then I did ps -fu myuserid
I saw that $myexe was still running
Q1) How can i force child process to exit? threads->exit() didnt seem to work

Answer 1

The most obvious problem with the sample program is that it is using multiple threads for the curses library. That won't work. (curses is not thread-safe). If you have to do this, keep all of the curses work in the same thread.

Answer 2

You call exit but don't detach or join the threads.
Stick:
foreach my $thr ( threads -> list() ) {
$thr -> join;
}
at the end, and your 'main' code will wait for your threads to (all) exit.
However - threads -> exit() is for exiting the current thread. See:
http://perldoc.perl.org/threads.html#EXITING-A-THREAD
In order to terminate another thread, you need something like threads -> kill. Either send a 'proper' kill signal, or use a signal handler for SIGUSR1 or similar.
I'd probably approach it a little differently though - define a shared variable:
my $done : shared;
And then test it within the while loop, so you've a normal execution flow rather than a mid flight kill.
Your kill ( INT, $$ ) is going to be killing your main process, and just drop the threads on the floor. That's not good style really.
So - to backtrack a bit - the problem you're having - I think - is because 'signals' in perl aren't what you're expecting them to be. Perl uses safe signals, which makes a blocking call (such as a read from a filehandle) block the signal.
http://perldoc.perl.org/perlipc.html#Deferred-Signals-%28Safe-Signals%29
So I wouldn't normally suggest using signals within threads are a good idea - they're a little erratic, which isn't good for program predictability.
You can 'throw' and 'catch' signals, by defining a signal handler within the thread:
$SIG{'USR1'} = sub { print "Caught USR1"; die };
And then 'call' it using:
$worker -> kill ( 'USR1' );
But in certain circumstances, that won't 'bail out' immediately in the way you expect.
For example - this will work:
#!/usr/bin/perl
use strict;
use warnings;
use threads;
sub worker {
print Dumper \%SIG;
my $tail_pid = open ( my $tail_proc, "-|", "tail -f /var/log/messages" );
$SIG{'USR1'} = sub { print "Caught USR1\nKilling $tail_pid"; kill ( 'TERM', $tail_pid ); die; threads -> exit() };
print "Pre-loop\n";
while ( 1 ) {
print "Thread processing\n";
sleep 1;
}
print "Done";
return;
}
my $worker = threads -> create ( \&worker );
sleep 2;
print "Sending kill\n";
$worker -> kill ( 'SIGUSR1' );
sleep 2;
print "waiting for join\n";
$worker -> join();
But if your while loop is reading from the file handle - it's a blocking call, so the 'kill' will be held until the block lifts.
E.g.
while ( <$tail_proc> ) {
Will go into a block pending IO, and your thread won't 'get' the signal until IO occurs, and the thread continues processing. That might be sufficient for your needs though. Otherwise you're potentially looking at select or IO::Select to test if the handle is readable.
So what you may want to do instead is just kill the process that's 'feeding' your while loop - because by doing so, it'll unblock and the while will become undef and exit.
E.g.:
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
my $kill_pid : shared;
sub worker {
$kill_pid = open ( my $tail_proc, "-|", "tail -f /var/log/messages" );
print "Pre-loop\n";
while ( <$tail_proc> ) {
print "Thread processing\n";
print;
sleep 1;
}
print "Done";
return;
}
my $worker = threads -> create ( \&worker );
sleep 2;
print "Sending kill\n";
if ( defined $kill_pid ) { print "killing tail, $kill_pid\n"; kill ( 'TERM', $kill_pid ); };
sleep 2;
print "waiting for join\n";
$worker -> join();