# File: EventDispatcher.pm # # Purpose: Registers event handlers and dispatches events to them. # # Note: PBot::Core::EventDispatcher has no relation to PBot::Core::EventQueue. # SPDX-FileCopyrightText: 2014-2023 Pragmatic Software # SPDX-License-Identifier: MIT package PBot::Core::EventDispatcher; use parent 'PBot::Core::Class'; use PBot::Imports; use PBot::Core::Utils::PriorityQueue; sub initialize { my ($self, %conf) = @_; # hash table of event handlers $self->{handlers} = {}; } # add an event handler # # priority ranges from 0 to 100. 0 is the highest priority, i.e. an handler with # priority 0 will handle events first. 100 is the lowest priority and will handle # events last. priority defaults to 50 if omitted. # # NickList reserves 0 and 100 to ensure its list is populated by JOINs, etc, # before any handlers need to consult its list, or depopulated by PARTs, QUITs, # KICKs, etc, after any other handlers need to consult its list. sub register_handler { my ($self, $name, $subref, $priority) = @_; # get the package of the calling subroutine my ($package) = caller(0); # internal identifier to find calling package's event handler my $handler_id = "$package-$name"; my $entry = { priority => $priority // 50, id => $handler_id, subref => $subref, }; # create new priority-queue for event-name if one doesn't exist if (not exists $self->{handlers}->{$name}) { $self->{handlers}->{$name} = PBot::Core::Utils::PriorityQueue->new(pbot => $self->{pbot}); } # add the event handler $self->{handlers}->{$name}->add($entry); # debugging if ($self->{pbot}->{registry}->get_value('eventdispatcher', 'debug')) { $self->{pbot}->{logger}->log("EventDispatcher: Add handler: $handler_id\n"); } } # remove an event handler sub remove_handler { my ($self, $name) = @_; # get the package of the calling subroutine my ($package) = caller(0); # internal identifier to find calling package's event handler my $handler_id = "$package-$name"; # remove the event handler if (exists $self->{handlers}->{$name}) { my $handlers = $self->{handlers}->{$name}; for (my $i = 0; $i < $handlers->count; $i++) { my $handler = $handlers->get($i); if ($handler->{id} eq $handler_id) { $handlers->remove($i--); } } # remove root event-name key if it has no more handlers if (not $self->{handlers}->{$name}->count) { delete $self->{handlers}->{$name}; } } # debugging if ($self->{pbot}->{registry}->get_value('eventdispatcher', 'debug')) { $self->{pbot}->{logger}->log("EventDispatcher: Remove handler: $handler_id\n"); } } # send an event to its handlers sub dispatch_event { my ($self, $name, $data) = @_; # debugging flag my $debug = $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug') // 0; # undef means no handlers have handled this event my $dispatch_result= undef; # if the event-name has handlers if (exists $self->{handlers}->{$name}) { # then dispatch the event to each one foreach my $handler ($self->{handlers}->{$name}->entries) { # debugging if ($debug) { $self->{pbot}->{logger}->log("Dispatching $name to handler $handler->{id}\n"); } # invoke an event handler. a handler may return undef to indicate # that it decided not to handle this event. my $handler_result = eval { $handler->{subref}->($name, $data) }; # check for exception if (my $exception = $@) { $self->{pbot}->{logger}->log("Exception in event handler: $exception"); } else { # update $dispatch_result only when handler result is a defined # value so we remember if any handlers have handled this event. $dispatch_result = $handler_result if defined $handler_result; } } } # return undef if no handlers have handled this event; otherwise the return # value of the last event handler to handle this event. return $dispatch_result; } 1;