4

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:

... 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 ... :)

Community
  • 1
  • 1
sdaau
  • 36,975
  • 46
  • 198
  • 278

1 Answers1

5

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);
   }
}
ikegami
  • 367,544
  • 15
  • 269
  • 518
  • Many thanks for that, @ikegami - I see what the problem is now. Cheers! – sdaau Sep 23 '11 at 21:01
  • Set the environment variable `PERL_SIGNALS` to `unsafe`, or see [`Perl::Signals::Unsafe`](http://search.cpan.org/perldoc?Perl::Signals::Unsafe) for a workaround. – mob Sep 23 '11 at 21:02
  • No, really don't do what @mob suggests. Find another way. – ikegami Sep 23 '11 at 21:25
  • Thanks for mentioning that, @mob - I have posted an example of that below, but its segfaulting or generating errors... – sdaau Sep 23 '11 at 21:30
  • @sdaau, Added possible solution. – ikegami Sep 23 '11 at 21:32
  • @ikegami - I really hope someone can point to an alternative; otherwise everything I'm finding gives no results, as my posts here show :) Thanks - cheers! – sdaau Sep 23 '11 at 21:32
  • Many, many thanks for your edit, @ikegami - thanks to it, I now have a code that finally works, which is posted in my answer below... Cheers! – sdaau Sep 23 '11 at 22:02