CODEWITHSUNDEEP
linuxperl
sdaau
sdaau

Reputation: 38641

Breaking out of a while loop with system commands in Perl using Ctrl-C (SIGINT)?

Consider the following example, test.pl:

#!/usr/bin/env perl

use 5.10.1;
use warnings;
use strict;

$SIG{'INT'} = sub {print "Caught Ctrl-C - Exit!\n"; exit 1;};

$| = 1; # turn off output line buffering

use Getopt::Long;
my $doSystemLoop = 0;

GetOptions( "dosysloop"=>\$doSystemLoop );
print("$0: doSystemLoop is:$doSystemLoop (use " . (($doSystemLoop)?"system":"Perl") . " loop); starting...\n");

my $i=0;

if (not($doSystemLoop)) { # do Perl loop

    while ($i < 1e6) {
      print("\tTest value is $i");
      $i++;
      sleep 1;
      print(" ... ");
      sleep 1;
      print(" ... \n");
    }

} else {                  # do system call loop

    while ($i < 1e6) {
      system("echo","-ne","\tTest value is $i");
      $i++;
      system("sleep 1");
      system("echo","-ne"," ... ");
      system("sleep 1");
      system("echo","-e"," ... ");
    }

}

So, if I call this program, so it uses a usual Perl loop, everything is as expected:

$ perl test.pl
test.pl: doSystemLoop is:0 (use Perl loop); starting...
    Test value is 0 ...  ... 
    Test value is 1 ...  ... 
    Test value is 2 ... ^CCaught Ctrl-C - Exit!
$

... that is, I hit Ctrl-C, program exits instantly.

However, if the while loop's commands consist mostly of system calls, then it becomes nearly impossible to exit with Ctrl-C:

$ perl test.pl --dosysloop
test.pl: doSystemLoop is:1 (use system loop); starting...
    Test value is 0 ...  ... 
    Test value is 1 ...  ... 
    Test value is 2 ... ^C ... 
    Test value is 3 ... ^C ... 
    Test value is 4 ... ^C ... 
    Test value is 5^C ... ^C ... 
    Test value is 6^C ... ^C ... 
    Test value is 7^C ... ^C ... 
    Test value is 8^C ... ^C ... 
    Test value is 9^C ... ^C ... 
    Test value is 10 ... ^C ... 
    Test value is 11^C ... ^C ... 
    Test value is 12^C ...  ... 
    Test value is 13^Z
[1]+  Stopped                 perl test.pl --dosysloop
$ killall perl
$ fg
perl test.pl --dosysloop
Terminated
$

So in the snippet above, I'm hitting Ctrl-C (the ^C) like mad, and the program ignores me completely :/ Then I cheat by hitting Ctrl-Z (the ^Z), which stops the process and sets in the background; then in the resulting shell I do killall perl, and after that I execute the fg command, which places the Perl job back in the foreground - where it finally terminates due to the killall.

What I would like to have, is run a system loop like this, with the possibility to break out of it/exit it with the usual Ctrl-C. Is this possible to do, and how do I do that?

Upvotes: 4

Views: 3068

Answers (2)

Slaven Rezic
Slaven Rezic

Reputation: 4581

Check the exit status of the system() command for any signals. An external command interrupted with SIGINT will get a "2" here:

while () {
    system("sleep", 1);
    if ($? & 127) {
        my $sig = $? & 127;
        die "Caught signal INT" if $sig == 2; # you may also abort on other signals if you like
    }
}

Upvotes: 2

amon
amon

Reputation: 57640

Perl's signal handling mechanism defers the handling of signals until a safe point. Deferred signals are checked between Opcodes of the perl VM. As system and friends count as a single opcode, signals are only checked once the exec'd command has terminated.

This can be circumvented by forking, and then waiting in a loop for the child process to terminate. The child can also be terminated early via a signal handler.

sub launch_and_wait {
  my $wait = 1;
  my $child;

  local $SIG{CHLD} = sub {
    $wait = 0;
  };
  local $SIG{INT}  = sub {
    $wait = 0;
    kill KILL => $child if defined $child;
  };

  if ($child = fork()) {
    # parent

    while ($wait) {
      print "zzz\n";
      sleep 1;
    }
    wait; # try to join the child

  } else {
    # child

    exec {$_[0]} @_;

  }
}

launch_and_wait sleep => 60;
print "Done\n";

There are probably lots of ways this can go wrong (getting a SIGINT before the child was spawned…). I also omitted any error handling.

Upvotes: 2

Related Questions