Perl threads with alarm

Is there any way 开发者_如何转开发to get alarm (or some other timeout mechanism) working in perl (>=5.012) threads?

Run alarm in your main thread, with a signal handler that signals your active threads.

use threads;
$t1 = threads->create( \&thread_that_might_hang );
$t2 = threads->create( \&thread_that_might_hang );
$SIG{ALRM} = sub {
    if ($t1->is_running) { $t1->kill('ALRM'); }
    if ($t2->is_running) { $t2->kill('ALRM'); }
};

alarm 60;
# $t1->join; $t2->join;
sleep 1 until $t1->is_joinable; $t1->join;
sleep 1 until $t2->is_joinable; $t2->join;
...

sub thread_that_might_hang {
    $SIG{ALRM} = sub { 
        print threads->self->tid(), " got SIGALRM. Good bye.\n";
        threads->exit(1);
    };
    ... do something that might hang ...
}

If you need different alarms for each thread, look into a module that allows you to set multiple alarms like Alarm::Concurrent.

Edit: commentors point out threads::join interferes with SIGALRM, so you may need to test $thr->is_joinable rather than calling $thr->join