Perl — Сигналы/слоты и EV (libev) из песочницы

В данной статье предложена реализация механизма сигналов и слотов в языке Perl посредством модуля EV («perl-биндинг» к libev).

EV (libev)

EV — perl interface to libev, a high performance full-featured event loop. Данный модуль позволяет создавать приложения, работа которых строится на основе происходящих событий (доступность дескрипторов для чтения/записи, получение сигналов операционной системы, срабатывание таймеров, изменение состояния файлов и др.). Работа организуется следующим образом (упрощённо):

• для каждого события, интересующего нас, создаётся объект-наблюдатель;
• для каждого созданного объекта-наблюдателя регистрируется обработчик. Таким образом, при наступлении интересующего нас события, объект-наблюдатель вызывает связанный с ним обработчик (callback);
• запускается цикл сборки событий. В начале каждой итерации весь процесс блокируется до тех пор, пока не произойдёт хотя бы одно из интересующих нас событий. Для каждого произошедшего события вызывается обработчик (связанный с этим событием посредством объекта-наблюдателя).

Выход из бесконечного событийного цикла, в свою очередь, также происходит по определённому событию, например – по сигналу SIGINT (либо, когда не осталось ни одного из активных объектов-наблюдателей).

Сигналы и слоты

Сигналы и слоты – это механизм коммуникации между объектами. Широко используется в фреймворке QT (http://doc.qt.nokia.com/5.0-snapshot/signalsandslots.html). Суть заключается в следующем (упрощённо):

• объект A содержит сигнал a;
• объект B содержит сигнал b;
• объекты C и D содержат слоты c и d соответственно;
• сигнал a объекта A соединяем со слотом c объекта C и сигналом b объекта B;
• сигнал b объекта B соединяем со слотом d объекта D;
• испускаем сигнал a при наступлении определённого события. В результате, срабатывает слот c и испускается сигнал b, который в свою очередь вызывает срабатывание слота d.

Теперь о природе сигналов и слотов. В QT и те, и другие являются специальными функциями. Однако, по сути, сигнал – это какой-либо объект, который мы можем «испускать» при наступлении интересующего нас события с параметрами, которые необходимо передать слоту. Слот же должен реализовывать какую-то функциональность при наступлении этого события с параметрами, переданными сигналом. При этом сигнал полностью принадлежит одному объекту и «испускается» только им, а слот принадлежит другому объекту, и именно этот другой объект выполняет «полезную работу». Объекты не обязаны знать о существовании друг друга, главное – правильно (так как нам нужно) соединить сигналы и слоты.
К одному сигналу может быть подключено любое количество слотов, либо других сигналов. Если с сигналом связано несколько слотов, порядок их «срабатывания» должен соответствовать порядку подключения этих слотов к этому сигналу. Слот может быть подключён к любому количеству сигналов.

Сигналы и слоты + EV

Для начала, пару слов об интерфейсе. Я пожертвую внешней схожестью с QT ради простоты и удобства:

• сигналы – обычные объекты в языке Perl;
• слоты – ссылка на подпрограмму либо объект + имя метода;
• функция connect – функция объекта сигнала;
• функция emit – функция объекта сигнала.

Выглядеть это будет примерно так:

…
my $signal = new EV::SignalSlot;
…
$signal->connect($another_signal);
$signal->connect(\&some_sub);
$signal->connect($object, 'method_name');
…
$signal->emit(@args);
…

Теперь о некоторых особенностях EV, которые позволят реализовать весь механизм:

• можно создавать неактивные объекты-наблюдатели (сборка событий для таких объектов осуществляется только после активизации)
• можно искусственно «скармливать» события неактивному объекту-наблюдателю, при этом он активизируется и реагирует на «скормленное» событие так, как будто оно произошло само по себе, не зависимо от нас;
• искусственно «скормленные» события заносятся в стек, т.е. последнее «скормленное» событие будет обработано первым. Обработка этих событий будет осуществляться на той же итерации событийного цикла, на которой они были помещены в стек и только после того, как будут обработаны все реально возникнувшие события;
• можно передавать дополнительные данные (скаляр) в обработчик события через метод data() объекта-наблюдателя. Каждый обработчик вызывается со следующими параметрами – объект-наблюдатель, с которым он связан и битовая маска событий.

my $timer = EV::timer_ns(0, 0, \&some_sub);
$timer->data(\@args);
$timer->feed_event(EV::TIMER);
…
sub some_sub {
    my ($watcher, $revents) = @_;
    my $arr_ref = $watcher->data();
    do_something(@{ $arr_ref });
    …
}

Если представить слот как неактивный объект-наблюдатель с установленным обработчиком, а «испускание» сигнала – как «скармливание» события и передачу дополнительных данных в виде скаляра этому неактивному обработчику, то механизм сигналов и слотов можно реализовать следующим образом:

Результат

package EV::SignalSlot;

use strict;
use warnings;

use EV;
use Scalar::Util;


#------------------------------------------------------------------------------#
sub new {
    my $class = shift;

    return bless([] => $class);
}

#------------------------------------------------------------------------------#
sub connect {
    my $self = shift;

    my ($slot, $tag);
    if (@_ == 1 && ref $_[0] eq 'EV::SignalSlot') {
        my $signal = shift;
        $slot = sub {
            my $args = $_[0]->data();
            $signal->emit(@{ $args });
            return;
        };
        $tag = "$signal";
    }
    elsif (@_ == 1 && ref $_[0] eq 'CODE') {
        my $coderef = shift;
        $slot = sub {
            my $args = $_[0]->data();
            $coderef->(@{ $args });
            return;
        };
        $tag = "$coderef";
    }
    elsif (@_ == 2) {
        my ($object, $method_name) = @_;
        if (Scalar::Util::blessed($object) && (my $method = $object->can($method_name))) {
            $slot = sub {
                my $args = $_[0]->data();
                $method->($object, @{ $args });
                return;
            };
            $tag = "$object:$method_name";
        }
        else {
            return;
        }
    }
    else {
        return;
    }

    unshift @{ $self }, { $tag => EV::timer_ns(0, 0, $slot) };
    return;
}

#------------------------------------------------------------------------------#
sub disconnect {
    my $self = shift;

    my $tag = join ':', @_;
    @{ $self } = grep { my ($k, $v) = %{ $_ }; $k ne $tag } @{ $self };
    return;
}

#------------------------------------------------------------------------------#
sub emit {
    my $self = shift;

    foreach my $connected (@{ $self }) {
        my (undef, $slot) = %{ $connected };
        $slot->data(\@_);
        $slot->feed_event(EV::TIMER);
    }
}

#------------------------------------------------------------------------------#
sub DESTROY { }

#------------------------------------------------------------------------------#
1;

__END__

Пример использования

#!/usr/bin/perl
$| = 1;

use strict;
use warnings;

use EV;
use EV::SignalSlot;


#------------------------------------------------------------------------------#
package MyCounter;

sub new {
    my $class = shift;

    my $self = {
        changed => new EV::SignalSlot,
        val => shift || 0,
    };
    return bless($self => $class);
}

sub incr {
    my $self = shift;
    my $val  = shift || 1;

    $self->{val} += $val;
    $self->{changed}->emit($val);
}

sub decr {
    my $self = shift;
    my $val  = shift || 1;

    $self->{val} -= $val;
    $self->{changed}->emit($val);
}

sub get_val {
    return $_[0]->{val};
}

sub get_signal {
    return $_[0]->{changed};
}

#------------------------------------------------------------------------------#
package main;

my $counterA = new MyCounter;
my $counterB = new MyCounter;
my $counterC = new MyCounter;
my $counterD = new MyCounter;

$counterA->get_signal()->connect($counterB->get_signal());
$counterA->get_signal()->connect($counterC, 'decr');
$counterB->get_signal()->connect($counterD, 'decr');
$counterC->get_signal()->connect(\&dump);

my $timer1 = EV::timer(1, 0.5, sub{ $counterA->incr(10) });
my $timer2 = EV::timer(3, 0, \&swap);
my $timer3 = EV::timer(7, 0, sub{ EV::break() });

EV::run();

#------------------------------------------------------------------------------#
sub swap {
    $counterA->get_signal()->disconnect($counterC, 'decr');
    $counterB->get_signal()->disconnect($counterD, 'decr');
    $counterA->get_signal()->connect($counterC, 'incr');
}

sub dump {
    print "A=", $counterA->get_val(), "\t",
          "B=", $counterB->get_val(), "\t",
          "C=", $counterC->get_val(), "\t",
          "D=", $counterD->get_val(), "\t[iteration=", EV::loop_count(), "]\n";
}

Вывод на экран примерно такой:

$ ./test_ss.pl
A=10    B=0     C=-10   D=-10   [iteration=1]
A=20    B=0     C=-20   D=-20   [iteration=2]
A=30    B=0     C=-30   D=-30   [iteration=3]
A=40    B=0     C=-40   D=-40   [iteration=4]
A=50    B=0     C=-50   D=-50   [iteration=5]
A=60    B=0     C=-40   D=-50   [iteration=6]
A=70    B=0     C=-30   D=-50   [iteration=7]
A=80    B=0     C=-20   D=-50   [iteration=8]
A=90    B=0     C=-10   D=-50   [iteration=9]
A=100   B=0     C=0     D=-50   [iteration=10]
A=110   B=0     C=10    D=-50   [iteration=11]
A=120   B=0     C=20    D=-50   [iteration=12]
A=130   B=0     C=30    D=-50   [iteration=13]

Заключение

Счётчики это, конечно, надуманный пример, однако использование данного механизма может быть вполне реальным. Например, сокет может испускать сигнал после того, как получены все данные. Подключенный к этому сигналу слот парсера протокола распарсит эти данные, а слот статистики соберёт статистику (размер полученных данных, время обработки и т.п.). Иными словами — простор для творчества.
Что касается предложенной реализации — усовершенствования и нововведения приветствуются.