Используя sigtrap в модуле perl, как мне получить ловушку, полученную обратно в контексте объекта?

Question

В разделе «НАЧАЛО» моего модуля есть:

use sigtrap qw(handler shutdown normal-signals);
use sigtrap qw(die untrapped normal-signals stack-trace any error-signals);

Но когда sigtrap ловит INT и т. Д., То, что я получаю в моем закрытом сабвуфере, содержит только ловушку, а не дескриптор объекта. Нет $ self.

sub shutdown {
    my $sig = shift || 'Nothing';   
    print "Got signal: $sig\n";
    exit;
}

просто возвращает

Got signal: INT

Мой DESTROY get вызывается как раз вовремя и имеет доступ к дескриптору объекта, но, поскольку у меня не было доступа к дескриптору при выключении, я не смог его сохранить и понятия не имел, что это за сигнал.

Мне нужно знать, какую ловушку я получил, чтобы мой метод DESTROY мог регистрировать, что вызвало отключение.

Возможно, sigtrap здесь не лучший выбор. Мнения приветствуются.

Answer 1

Я проверил sigtrap, это не модуль OO, если вы хотите использовать его как единое целое, вам может потребоваться использовать замыкание вместо метода объекта.

Таким образом, вы можете определить свой класс следующим образом:

package SigHandler;

sub new { 
    my $class = shift;
    return bless { @_ }, $class;
}

sub on_signal_int { 
    my $self = shift;
    ...
}

sub get_handler { 
    my $self       = shift;
    my @other_args = shift;
    ...
    return sub { 
        my $sig = shift;
        if ( $sig == INT ) { 
            return $self->on_signal_int();
        }
    };
}

И затем назвать его так:

use handler => SigHandler->new->get_handler, 'normal-signals';

Answer 2

Обработчики сигналов Perl, включая те, которые установлены с помощью sigtrap, относятся к программному уровню, а не к объектному уровню.Поэтому, когда Perl вызывает обработчик, у него нет объекта для передачи вам.

Если вы хотите очистить группу объектов при получении сигнала, вам нужно будет написать код вашего модуля, чтобы отслеживатьобъекты, которые он создал.Затем, когда вы получите сигнал, вы можете пройти через эти объекты и выполнить любые методы уничтожения.

Что-то вроде этого должно начать вас:

{package Test;
    use Scalar::Util 'weaken';
    use sigtrap handler => \&cleanup, 'normal-signals';

    my %objects;

    sub new {
        my ($class, $msg) = @_;
        my $self = [$msg];
        bless $self, $class;
        weaken($objects{$self} = $self);  # prevent memory leak
        $self
    }

    sub cleanup {
        my ($sig) = @_;
        say "cleanup on $sig";
        defined and $_->DESTROY for values %objects;
        exit;
    }

    sub DESTROY {
        my ($self) = @_;
        if (@$self) {
            say "DESTROY $self @$self";
            @$self = ();
            delete $objects{$self}
        }
    }

}

{my $obj1 = Test->new('out of scope')}

my $obj2 = Test->new('in scope');

1 while 1;

А при запуске:

$ perl so.pl
DESTROY Test=ARRAY(0x899150) out of scope
^Ccleanup on INT
DESTROY Test=ARRAY(0x824810) in scope

Answer 3

Спасибо за ваши идеи, но в итоге я обманул, используя global для отслеживания.Все экспорты и обычные вещи для краткости убраны

Package Blah;
our $SIG_CAUGHT = '';
BEGIN {
    use sigtrap qw(handler shutdown normal-signals);
    use sigtrap qw(die untrapped normal-signals stack-trace any error-signals);
}
sub shutdown {
    $SIG_CAUGHT = shift;
    exit;
}

sub DESTROY {
    my $self = shift;
    my $message = 'Daemon shutting down';
    $message .= '.  Caught signal: SIG' . $SIG_CAUGHT if ( $SIG_CAUGHT ne '' );
    $message .= ' with error: ' . $! if $!; 
    $self->logger({severity => 5, message => $message});
    $self->{_dbh} = undef;
}
1;

Протестировано .. правильно обрабатывает INT, KILL, DIE, распространяя ошибки при фатальном исходе.

Один приятный побочный эффект - запуск INT теперь одиннажатие клавиши.
В прошлом у меня была проблема, когда мне неоднократно приходилось управлять моими программами Control-C, чтобы они перестали работать.