# File: EventQueue.pm # # Purpose: Provides functionality to manage event subroutines which are invoked # at a future time, optionally recurring. # # Note: PBot::Core::EventQueue has no relation to PBot::Core::EventDispatcher. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT package PBot::Core::EventQueue; use parent 'PBot::Core::Class'; use PBot::Imports; use PBot::Utils::PriorityQueue; use Time::HiRes qw/time/; use Time::Duration; sub initialize { my ($self, %conf) = @_; # array of pending events $self->{event_queue} = PBot::Utils::PriorityQueue->new(pbot => $self->{pbot}); # register `eventqueue` bot command $self->{pbot}->{commands}->register(sub { $self->cmd_eventqueue(@_) }, 'eventqueue', 1); # add `can-eventqueue` capability to admin group $self->{pbot}->{capabilities}->add('admin', 'can-eventqueue', 1); } # eventqueue bot command sub cmd_eventqueue { my ($self, $context) = @_; my $usage = "Usage: eventqueue list [filter regex] | add [-repeat] | remove "; my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); if (not defined $command) { return $usage; } if ($command eq 'list') { return "No events queued." if not $self->{event_queue}->count; my $result = eval { my $text = "Queued events:\n"; my ($regex) = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); my $i = 0; my $events = 0; foreach my $event ($self->{event_queue}->entries) { $i++; if ($regex) { next unless $event->{id} =~ /$regex/i; } $events++; my $duration = $event->{priority} - time; if ($duration < 0) { # current time has passed an event's time but the # event hasn't left the queue yet. we'll show these # as, e.g., "pending 5s ago" $duration = 'pending ' . concise ago -$duration; } else { $duration = 'in ' . concise duration $duration; } $text .= " $i) $duration: $event->{id}"; $text .= ' [R]' if $event->{repeating}; $text .= ";\n"; } return "No events found." if $events == 0; return $text . "$events events.\n"; }; if (my $error = $@) { # strip source information to prettify error for non-developer consumption $error =~ s/ at PBot.*//; return "Bad regex: $error"; } return $result; } if ($command eq 'add') { my ($duration, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); if (not defined $duration or not defined $command) { return "Usage: eventqueue add [-repeat]"; } # convert text like "5 minutes" or "1 week" or "next tuesday" to seconds my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($duration); return $error if defined $error; # check for `-repeating` at front or end of command my $repeating = $command =~ s/^-repeat\s+|\s+-repeat$//g; my $cmd = { nick => $context->{nick}, user => $context->{user}, host => $context->{host}, hostmask => $context->{hostmask}, command => $command, }; $self->{pbot}->{interpreter}->add_to_command_queue($context->{from}, $cmd, $seconds, $repeating); return "Command added to event queue."; } if ($command eq 'remove') { my ($regex) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1); return "Usage: eventqueue remove " if not defined $regex; $regex =~ s/(?dequeue_event($regex); } return "Unknown command '$command'. $usage"; } # returns seconds until upcoming event. sub duration_until_next_event { my ($self) = @_; return 0 if not $self->{event_queue}->count; return $self->{event_queue}->get_priority(0) - time; } # invokes any current events and then returns seconds until upcoming event. sub do_events { my ($self) = @_; # early-return if no events available return 0 if not $self->{event_queue}->count; my $debug = $self->{pbot}->{registry}->get_value('eventqueue', 'debug') // 0; # repeating events to re-enqueue my @enqueue; for (my $i = 0; $i < $self->{event_queue}->entries; $i++) { # we call time for a fresh time, instead of using a stale $now that # could be in the past depending on a previous event's duration if (time >= $self->{event_queue}->get_priority($i)) { my $event = $self->{event_queue}->get($i); $self->{pbot}->{logger}->log("Processing event $i: $event->{id}\n") if $debug > 1; # call event's subref, passing event as argument $event->{subref}->($event); # remove event from queue $self->{event_queue}->remove($i--); # add event to re-enqueue queue if repeating push @enqueue, $event if $event->{repeating}; } else { # no more events ready at this time if ($debug > 2) { my $event = $self->{event_queue}->get($i); $self->{pbot}->{logger}->log("Event not ready yet: $event->{id} (timeout=$event->{priority})\n"); } last; } } # re-enqueue repeating events foreach my $event (@enqueue) { $self->enqueue_event($event->{subref}, $event->{interval}, $event->{id}, 1); } return $self->duration_until_next_event; } # check if an event is in the event queue. sub exists { my ($self, $id) = @_; return scalar grep { $_->{id} eq $id } $self->{event_queue}->entries; } # adds an event to the event queue, optionally repeating sub enqueue_event { my ($self, $subref, $interval, $id, $repeating) = @_; # default values $id //= "unnamed (${interval}s $subref)"; $repeating //= 0; $interval //= 0; # create event structure my $event = { id => $id, subref => $subref, interval => $interval, priority => time + $interval, repeating => $repeating, }; # add the event to the priority queue my $position = $self->{event_queue}->add($event); # debugging noise my $debug = $self->{pbot}->{registry}->get_value('eventqueue', 'debug') // 0; if ($debug > 1) { $self->{pbot}->{logger}->log("Enqueued new event $id at position $position: timeout=$event->{priority} interval=$interval repeating=$repeating\n"); } } # convenient alias to add an event with repeating defaulted to enabled. sub enqueue { my ($self, $subref, $interval, $id, $repeating) = @_; $self->enqueue_event($subref, $interval, $id, $repeating // 1); } # removes an event from the event queue, optionally invoking it. # `id` can contain `.*` and `.*?` for wildcard-matching/globbing. sub dequeue_event { my ($self, $id, $execute) = @_; my $result = eval { # escape special characters $id = quotemeta $id; # unescape .* and .*? $id =~ s/\\\.\\\*\\\?/.*?/g; $id =~ s/\\\.\\\*/.*/g; # compile regex my $regex = qr/^$id$/i; # count total events before removal my $count = $self->{event_queue}->count; # collect events to be removed my @removed = grep { $_->{id} =~ /$regex/i; } $self->{event_queue}->entries; # remove events from event queue @{$self->{event_queue}->queue} = grep { $_->{id} !~ /$regex/i; } $self->{event_queue}->entries; # set count to total events removed $count -= $self->{event_queue}->count; # invoke removed events, if requested if ($execute) { foreach my $event (@removed) { $event->{subref}->($event); } } # nothing removed return "No matching events." if not $count; # list all removed events my $removed = "Removed $count event" . ($count == 1 ? '' : 's') . ': ' . join(', ', map { $_->{id} } @removed); $self->{pbot}->{logger}->log("EventQueue: dequeued $removed\n"); return $removed; }; if ($@) { my $error = $@; $self->{pbot}->{logger}->log("Error in dequeue_event: $error\n"); $error =~ s/ at PBot.*//; return "$error"; } return $result; } # alias to dequeue_event, for consistency. sub dequeue { my ($self, $id) = @_; $self->dequeue_event($id); } # invoke and remove all events matching `id`, which can # contain `.*` and `.*?` for wildcard-matching/globbing. sub execute_and_dequeue_event { my ($self, $id) = @_; return $self->dequeue_event($id, 1); } # replace code subrefs for matching events. if no events # were found, then add the event to the event queue. sub replace_subref_or_enqueue_event { my ($self, $subref, $interval, $id, $repeating) = @_; # find events matching id my @events = grep { $_->{id} eq $id } $self->{event_queue}->entries; # no events found, enqueue new event if (not @events) { $self->enqueue_event($subref, $interval, $id, $repeating); return; } # otherwise update existing events foreach my $event (@events) { $event->{subref} = $subref; } } # remove existing events of this id then enqueue new event. sub replace_or_enqueue_event { my ($self, $subref, $interval, $id, $repeating) = @_; # remove event if it exists $self->dequeue_event($id) if $self->exists($id); # enqueue new event $self->enqueue_event($subref, $interval, $id, $repeating); } # add event unless it already had been added. sub enqueue_event_unless_exists { my ($self, $subref, $interval, $id, $repeating) = @_; # event already exists, bail out return if $self->exists($id); # enqueue new event $self->enqueue_event($subref, $interval, $id, $repeating); } # update the `repeating` flag for all events matching `id`. sub update_repeating { my ($self, $id, $repeating) = @_; foreach my $event ($self->{event_queue}->entries) { if ($event->{id} eq $id) { $event->{repeating} = $repeating; } } } # update the `interval` value for all events matching `id`. sub update_interval { my ($self, $id, $interval, $dont_enqueue) = @_; for (my $i = 0; $i < $self->{event_queue}->count; $i++) { my $event = $self->{event_queue}->get($i); if ($event->{id} eq $id) { if ($dont_enqueue) { # update interval in-place without moving event to new place in queue # (allows event to fire at expected time, then updates to new timeout afterwards) $event->{interval} = $interval; } else { # remove and add event in new position in queue $self->{event_queue}->remove($i); $self->enqueue_event($event->{subref}, $interval, $id, $event->{repeating}); } } } } 1;