Perl Signal Processing Only Works Once When Sighandler Calls Subroutine

perl signal processing only works once when sighandler calls subroutine

Generally, signals are masked when you are inside a signal handler, unless you set the SA_NODEFER flag through a sigaction call (in perl: POSIX::SigAction).

So, your second invocation of main() from within the signal handler runs main() with SIGALRM blocked. Your execution looks like this:

time | No Signals Blocked | SIGALRM Blocked
-----+--------------------+------------------
  0  |   main()           |
  1  |    while ...       |
  2  |     eval {         |
  3  |      $SIG{ALRM}... |
 ... |     sleep          |
     |    <<ALARM>>       | $SIG{ALRM} invoked
  n  |                    | restartservice()
 n+1 |                    |  main()
 n+2 |                    |   while ...
 n+3 |                    |    ....
 n+4 |                    |  <<ALARM>>       # <-- blocked, no effect

Good practice is to do something very small and discrete in a signal handler, like set a flag or, sometimes, throw an exception. In perl, the eval{}+alarm idiom is usually the latter:

while (1) {
  my $ok = eval {
    local $SIG{ALRM} = sub { die "ALARM"; };
    alarm(5);
    do_something();
    alarm(0);
    1; # $ok
  };
  next if $ok;
  if ($@ =~ /ALARM/) {
    # timed out
  } else {
    # some other failure
  }
}

perl multiple sig handlers pointing to one subroutine

$SIG{'INT', 'TERM'} isn't what you mean; to assign values for both keys like that, use a hash slice (and provide two values):

@SIG{'INT', 'TERM'} = (\&issueKdestroy, \&issueKdestroy);

With a $ instead, you are invoking the perl4 style multidimensional array emulation that allowed multiple keys to be specified but stored them all in a single hash, equivalent to:

$SIG{ join $;, 'INT', 'TERM' }

where $; is chr(0x1c) by default.

Help converting to subroutine

How much do you want to break things down? It's hard to see what the "best" or "right" way to split things up is without more code.

In general, if you go through your code and add comments describing what each block of code does, you could just as readily replace each commented block with a sub that has a name that recaps the sentence:

# Is this a sentence block?
next unless ( $sent_block =~ /\[sent. \d+ len. \d+\]: \[.+\]/ );    
           #1#

my ( $sentence, $sentence_number ) = parse_sentence_block($sent_block);

# Get chapter info if present
if ( $sentence =~ /\~\s(\d*F*[\.I_]\w+)\s/ ) {                                #2#
    $chapter_number = $1;
    $chapter_number =~ tr/./_/;
}

# Skip if key found
next
  unless ( $sentence =~ /\b\Q$search_key\E/i                                  #3#
    && $sentence =~ /\b\Q$addkey0\E/i
    && $sentence =~ /\b\Q$addkey1\E/i );

# skip if excrescence 0 (or whatever exc is short for)
next
  if ( defined($exc0)                                                         #4#
    && length($exc0)
    && $sentence =~ /\b\Q$exc0\E\b/i );
# skip if excrescence 1.
next
  if ( defined($exc1)                                                         #5#
    && length($exc1)
    && $sentence =~ /\b\Q$exc1\E\b/i );

Now take these comments and make them into subs:

next unless is_sentence_block( $sent_block );

my( $sentence, $sentence_number ) = parse_sentence_block($sent_block);

# Maybe update the chapter number
my $new_chapter_number = get_chapter_number( $sentence );
$chapter_number = $new_chapter_number if defined $new_chapter_number;

next unless have_all_keys( $sentence => $search_key, $add_key0, $add_key1 ); 

next if have_excrescence( $exc0 );
next if have_excrescence( $exc1 );

sub is_sentence_block {
    my $block = shift;

    return $sent_block =~ /\[sent. \d+ len. \d+\]: \[.+\]/ );
}

sub get_chapter_number {
    my $sentence = shift;

    return unless $sentence =~ /\~\s(\d*F*[\.I_]\w+)\s/;
    return $1;
}

sub have_all_keys {
     my $sentence = shift;
     my @keys = @_;

     for my $key ( @keys ) { 
         return unless $sentence =~ /\b\Q$key1\E/i;
     }

     return 1
}

sub have_excrescence {
    my $sentence = shift;
    my $exc      = shift;

    return 0 unless defined($exc);
    return 0 unless length($exc)
    return 0 unless $sentence =~ /\b\Q$exc\E\b/i );

    return 1;
}

Can I set a single signal handler for all signals in Perl?

You really don't want to do this. Only install signal handlers for the signals you need to handle differently than default (which we can't help you with, since you don't mention what kind of application you are writing).

In most normal cases, you don't have to write signal handlers at all -- the defaults are set up to do exactly what you need. You should read perldoc perlipc right now so you are aware of what cases you have that differ from normality.

You can modify more than one signal at once with the sigtrap pragma: it is useful for adding handlers for normally-untrapped signals, or for making normal error handling more strict.

# install a trivial handler for all signals, as a learning tool
use sigtrap 'handler' => \&my_handler, 'signal';
sub my_handler
{
    print "Caught signal $_[0]!\n";
}

Perl 5.10 - POSIX Signals ignored unless received during sleep() call?

Setting up the signal handler before the DBI calls somehow leads it to being ignored after some of the DBI methods are called. The solution was to move the signal handler subroutine to just before the processing loop, but after the call to execute:

#/usr/bin/perl
use DBI;

# SIGPIPE handler used to be here

my $db = "redacted";
my $user = "redacted";
my $pass = "redacted";
my $table = "redacted";

my $ora = DBI->connect("dbi:Oracle:" . $db, $user, $pass);
my $sql = "SELECT * FROM " . $table;
my $query = $ora->prepare($sql);
$query->execute();

$SIG{PIPE} = sub { print STDERR "WARNING: Received SIGPIPE"; exit(1); };

while (my @row = $query->fetchrow_array()) {
    print(join('|', @row) . "\n");
}

if ( $DBI::err ) { print STDERR "ERROR: Unload terminated due to error"; }

I'm not exactly sure why it fixes the issue, but it does.

Properly Use this Perl Module

:DEFAULT has a builtin definition which takes precedence over yours. It exports all the symbols that are exported by default, which is to say all the symbols in @EXPORT. You should have used:

our @EXPORT      = qw( mergeSort );
our @EXPORT_OK   = @EXPORT;
our %EXPORT_TAGS = ( ALL => \@EXPORT_OK );

use MergeSort;   # Same as: use MergeSort qw( :DEFAULT );

But I think explicitly listing one's imports is a good idea, so I'd use

our @EXPORT      = qw( );
our @EXPORT_OK   = qw( mergeSort );
our %EXPORT_TAGS = ( ALL => \@EXPORT_OK );

use MergeSort qw( mergeSort );

Get the TTY which sent a signal in Perl

The simplest solution is the one proposed by nab in a comment to your question: just log your output to a file (possibly in your $SIG{USR1} handler), and then monitor that. You could even overwrite it each time you get a SIGUSR1.

Another solution, which I've got running, is to create a socket handler. This gets a bit more convoluted, unless you're willing to use a bunch of modules. My solution is to use AnyEvent + Coro. I put the main work in one Coro thread, start up my AnyEvent::Socket::tcp_server(s) (socket and/or tcp port number), and, on connection, do what I need to do (in my case, create a bunch of threads, in your case just output the details like you do in your $SIG{USR1} handler, and close the connection).

Real code:

AnyEvent::Socket::tcp_server "unix/", "/tmp/cbstats.sock", sub {
    my $fh = shift;
    $fh->binmode(':utf8');
    $fh = unblock $fh;

    $self->handle_connection($fh, @_);

};

And then, because mine is interactive, I run socat readline /tmp/cbstats.sock. In your case, you could just do socat stdout /tmp/your.socket any time you wanted the output. (Use filesystem permissions to restrict/allow who can see this data.)

There's a little bit to concern yourself here - you'll need to stop using sleep() (or use the Coro version) so that you can receive requests on the socket. But, to be honest, it's been mostly minimal. I have, however, switched my server over to using AnyEvent timers, then I don't even need to worry about sleeping. After that, I smooshed multiple servers together on their own timers, and it has all worked fairly well.

Good luck.

Problems with $SIG{WINCH} when using it in a module

I think I've found the reason: apart from this module I load a second module which does use $SIG{WINCH} too.

When I don't load the second module the choose subroutine works as expected.

---

Related Topics