2017-03-05 22:33:31 +01:00
|
|
|
# This Source Code Form is subject to the terms of the Mozilla Public
|
|
|
|
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
|
|
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
|
|
|
2014-11-01 01:15:21 +01:00
|
|
|
package PBot::EventDispatcher;
|
2020-02-08 20:04:13 +01:00
|
|
|
use parent 'PBot::Class';
|
2014-11-01 01:15:21 +01:00
|
|
|
|
2020-02-08 20:04:13 +01:00
|
|
|
use warnings; use strict;
|
2019-07-11 03:40:53 +02:00
|
|
|
use feature 'unicode_strings';
|
|
|
|
|
2014-11-01 01:15:21 +01:00
|
|
|
use IO::Select;
|
|
|
|
|
|
|
|
sub initialize {
|
|
|
|
my ($self, %conf) = @_;
|
|
|
|
$self->{handlers} = { any => [] };
|
|
|
|
}
|
|
|
|
|
|
|
|
sub register_handler {
|
2020-02-07 21:12:55 +01:00
|
|
|
my ($self, $event_type, $sub, $package_override) = @_;
|
2020-02-08 05:45:29 +01:00
|
|
|
my ($package) = caller(0);
|
2020-02-07 21:12:55 +01:00
|
|
|
$package = $package_override if defined $package_override;
|
|
|
|
my $info = "$package\-\>$event_type";
|
|
|
|
$self->{pbot}->{logger}->log("Adding handler: $info\n") if $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug');
|
2016-11-17 03:59:13 +01:00
|
|
|
push @{$self->{handlers}->{$event_type}}, [$sub, $info];
|
2014-11-01 01:15:21 +01:00
|
|
|
}
|
|
|
|
|
2020-02-07 21:12:55 +01:00
|
|
|
sub remove_handler {
|
|
|
|
my ($self, $event_type, $package_override) = @_;
|
2020-02-08 05:45:29 +01:00
|
|
|
my ($package) = caller(0);
|
2020-02-07 21:12:55 +01:00
|
|
|
$package = $package_override if defined $package_override;
|
|
|
|
my $info = "$package\-\>$event_type";
|
|
|
|
|
|
|
|
if (exists $self->{handlers}->{$event_type}) {
|
|
|
|
for (my $i = 0; $i < @{$self->{handlers}->{$event_type}}; $i++) {
|
|
|
|
my $ref = @{$self->{handlers}->{$event_type}}[$i];
|
|
|
|
if ($info eq $ref->[1]) {
|
|
|
|
$self->{pbot}->{logger}->log("Removing handler: $info\n") if $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug');
|
|
|
|
splice @{$self->{handlers}->{$event_type}}, $i--, 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2014-11-01 01:15:21 +01:00
|
|
|
sub dispatch_event {
|
|
|
|
my ($self, $event_type, $event_data) = @_;
|
|
|
|
my $ret = undef;
|
|
|
|
|
|
|
|
if (exists $self->{handlers}->{$event_type}) {
|
2015-09-07 07:17:07 +02:00
|
|
|
for (my $i = 0; $i < @{$self->{handlers}->{$event_type}}; $i++) {
|
2016-11-17 03:59:13 +01:00
|
|
|
my $ref = @{$self->{handlers}->{$event_type}}[$i];
|
|
|
|
my ($handler, $info) = ($ref->[0], $ref->[1]);
|
2020-02-08 20:04:13 +01:00
|
|
|
my $debug = $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug') // 0;
|
|
|
|
$self->{pbot}->{logger}->log("Dispatching $event_type to handler $info\n") if $debug > 1;
|
2015-09-07 07:17:07 +02:00
|
|
|
|
|
|
|
eval {
|
|
|
|
$ret = $handler->($event_type, $event_data);
|
|
|
|
};
|
|
|
|
|
|
|
|
if ($@) {
|
|
|
|
chomp $@;
|
|
|
|
$self->{pbot}->{logger}->log("Error in event handler: $@\n");
|
2020-02-03 00:00:30 +01:00
|
|
|
#$self->{pbot}->{logger}->log("Removing handler.\n");
|
|
|
|
#splice @{$self->{handlers}->{$event_type}}, $i--, 1;
|
2015-09-07 07:17:07 +02:00
|
|
|
}
|
2014-11-01 01:15:21 +01:00
|
|
|
return $ret if $ret;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2015-09-07 07:17:07 +02:00
|
|
|
for (my $i = 0; $i < @{$self->{handlers}->{any}}; $i++) {
|
2016-11-17 03:59:13 +01:00
|
|
|
my $ref = @{$self->{handlers}->{any}}[$i];
|
|
|
|
my ($handler, $info) = ($ref->[0], $ref->[1]);
|
|
|
|
$self->{pbot}->{logger}->log("Dispatching any to handler $info\n") if $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug');
|
2015-09-07 07:17:07 +02:00
|
|
|
|
|
|
|
eval {
|
|
|
|
$ret = $handler->($event_type, $event_data);
|
|
|
|
};
|
|
|
|
|
|
|
|
if ($@) {
|
|
|
|
chomp $@;
|
|
|
|
$self->{pbot}->{logger}->log("Error in event handler: $@\n");
|
2020-02-03 00:00:30 +01:00
|
|
|
#$self->{pbot}->{logger}->log("Removing handler.\n");
|
|
|
|
#splice @{$self->{handlers}->{any}}, $i--, 1;
|
2015-09-07 07:17:07 +02:00
|
|
|
}
|
2014-11-01 01:15:21 +01:00
|
|
|
return $ret if $ret;
|
|
|
|
}
|
|
|
|
return $ret;
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|