Setting up signal handlers for an object with access to $self

[ZZamboni]

Give signal handlers within an object access to $self by defining them with an anonymous subroutine. Updated: to reflect additional comments below about establishing per-object signal handlers.

sub set_signal_handlers {
  my $self=shift;
  $SIG{USR1}=sub { $self->handler_USR1() }
  ...
}

sub handler_USR1 {
  my $self=shift;
  # Now I can access the object through $self
}

And call $object->set_signal_handlers() after creating the object (or $self->set_signal_handlers() from within the object itself).

---

As pointed out below, the above technique has the problem that signal handlers in Unix are per-process, so if more than one object sets a signal handler for the same signal using the technique above, only one of them will be executed. The following code solves this problem (slightly modified from code below, and combining my code with chromatic's) by using a single per-class signal handler, and a hash in which the specific per-object handlers are stored as code references. When the per-class handler is called, it calls all the per-object handlers in sequence. I wonder if this could be declared a belonging to class UNIVERSAL and then have every object in your program use it :-)

package Obj;

# Class variable
$handlers={};

sub new {
  my $class = shift;
  my $self = { @_ };
  bless $self, $class;
  $self->set_signal_handlers;
  $self;
}

sub name {
  shift->{'name'};
}

sub set_signal_handlers {
  my $self = shift;
  # Set handlers for USR1
  if (!$handlers{USR1}) {
    # Class signal handler, only set the first time
    $SIG{USR1} = sub { class_handle_signal('USR1'); };
  }
  # You could index by $self->name, or by any other identifier
  $handlers->{USR1}->{$self} = $self->handle_USR1();
  
  # Set handlers for USR1
  if (!$handlers{USR2}) {
    $SIG{USR2} = sub { class_handle_signal('USR2'); }
  }
  $handlers->{USR2}->{$self} = $self->handle_USR2();
}

sub handle_USR1 {
  my $self = shift;
  return sub {
    print "handling USR1 for ", $self->name, "\n";
  }
}

sub handle_USR2 {
  my $self = shift;
  return sub {
    print "handling USR2 for ", $self->name, "\n";
  }
}

sub class_handle_signal {
  my $sig=shift;
  foreach (keys %{$handlers->{$sig}}) {
    &{$handlers->{$sig}->{$_}}();
  }
}

package main;

my $obj1 = new Obj(name => 'obj1');
my $obj2 = new Obj(name => 'obj2');

while (1) { }

[chromatic]

Why not just make a reference to a subroutine? Here's my take on it:

#!/usr/bin/perl -w

use strict;

sub do_something {
    print "This is what I do.\n";
    exit;
}

$SIG{INT} = \&do_something;

while (1) {}

That's one less layer of indirection and conceptually clearer to me, at least. TIMTOWTDI!

[ZZamboni]

The point is to give the signal handler access to an object. If you simply point the signal handler to a subroutine, you do not have a way of accessing $self, unless it is stored in a class variable. By defining the signal handler with a closure, you can call the signal handler as if it were a method instead of a regular subroutine, therefore giving it access to $self (and the ability to access its methods and data).

[chromatic]

Hey, you're right! Very nice. (The word closure makes it obvious now.)

[btrott]

I like this quite a lot... only problem being that signals are unique to processes, not objects, so if you try to instantiate more than 1 of your objects and attach it to a signal handler, only the last object attached will actually have the signal handler installed.

For example, if I have this code:

package Obj;

sub new {
    my $class = shift;
    my $self = { @_ };
    bless $self, $class;
    $self->set_signal_handlers;
    $self;
}

sub name {
    shift->{'name'};
}

sub set_signal_handlers {
    my $self = shift;
    $SIG{USR1} = sub { $self->handle_USR1() }
}

sub handle_USR1 {
    my $self = shift;
    print "handling USR1 for ", $self->name, "\n";
}


package main;

my $obj1 = new Obj(name => 'obj1');
my $obj2 = new Obj(name => 'obj2');

while (1) { }

and I run this little script, then give it a USR1 signal, the only object that's ever going to catch that signal will be obj2. See what I'm saying?

All the same, it's a nice little method. :)

[ZZamboni]

Good point (about the signal being per-process). But with a little more work, you could make your signal handler "intelligent" to call the handlers for all the objects that have registered. Using your sample code as a base:

package Obj;

# Class variable
%handlers=();

sub new {
  my $class = shift;
  my $self = { @_ };
  bless $self, $class;
  $self->set_signal_handlers;
  $self;
}

sub name {
  shift->{'name'};
}

sub set_signal_handlers {
  my $self = shift;
  if (!%handlers) {
    # Class signal handler, only set the first time
    $SIG{USR1} = \&class_handle_USR1;
  }
  # You could index by $self->name, or by any other identifier
  $handlers{$self} = sub { $self->handle_USR1() };
}

sub handle_USR1 {
  my $self = shift;
  print "handling USR1 for ", $self->name, "\n";
}

sub class_handle_USR1 {
  foreach (keys %handlers) {
    &{$handlers{$_}}();
  }
}

package main;

my $obj1 = new Obj(name => 'obj1');
my $obj2 = new Obj(name => 'obj2');

while (1) { }

[chromatic]

Because I like CODE refs way too much:

sub set_signal_handlers {
    my $self = shift;
    if (!%handlers) {
        # Class signal handler, only set the first time
        $SIG{USR1} = \&class_handle_USR1;
    }
    # You could index by $self->name, or by any other identifier
    $handlers{$self} = $self->handle_USR1();
}

# skip a few

sub handle_USR1 {
    my $self = shift;
    return sub {
        print "handling USR1 for ", $self->name, "\n";
    }
}

That fits all of my definitions of beautiful.