# Simple cron-like component.
# Implements a recurring event generator that
# takes message-based commands.
# Copyright 2004 by Rocco Caputo.  Free software.
# Same terms as Perl itself.  Have fun!

package ChronicMessages;

use warnings;
use strict;

use POE;

# This Chronic component has a constructor.  It
# allows a symbolic name to be associated with
# the component at creation time.  This assists
# with message addressing.
#
# Note the "args" parameter, which is used to
# pass information into the _start event handler.

sub spawn {
  my ($class, %args) = @_;
  POE::Session->create(
    inline_states => {
      _start   => \&handle_setup,
      start    => \&handle_start,
      stop     => \&handle_stop,
      got_tick => \&handle_wakeup,
    },
    args => [ \%args ],
  );
}

# Event handlers.

# Start up the component.  This component moves
# the request sequence number into its heap.  It
# sets its alias based on the "args" passed in
# from POE::Session->create(), above.

sub handle_setup {
  my $args = $_[ARG0];
  $_[HEAP]->{id_seq} = 0;
  $_[KERNEL]->alias_set($args->{Alias});
}

# Start a new timer.  This is rather involved,
# overall, because we may need to maintain state
# for several requesting sessions and timers.

sub handle_start {
  my ($kernel, $heap ) = @_[KERNEL, HEAP];
  my ($sender, $param) = @_[SENDER, ARG0];

  my $sender_id   = $sender->ID;
  my $req_name    = $param->{Name};
  my $internal_id = ++$heap->{id_seq};

  # Set the initial timer here.
  my $timer_id    = $kernel->delay_set(
    "got_tick", $param->{Interval}, $internal_id
  );

  # Map session/event to the internal timer ID.
  $heap->{req}{$sender_id}{$req_name} =
    $internal_id;

  # Map the internal timer ID to information
  # needed to post an event when it's due.
  $heap->{timer}{$internal_id} = {
    timer_id  => $timer_id,
    sender_id => $sender_id,
    event     => $param->{Event},
    interval  => $param->{Interval},
  };

  # Hold the requesting session open, otherwise
  # it may go idle before the timer becomes due.
  $_[KERNEL]->refcount_increment(
    $sender->ID, "ticking",
  );
}

# Stop a timer.  Timers are keyed on the owning
# session and the requested event name.

sub handle_stop {
  my ($kernel, $heap ) = @_[KERNEL, HEAP];
  my ($sender, $param) = @_[SENDER, ARG0];

  my $sender_id = $sender->ID;
  my $req_name  = $param->{Name};

  # Remove the timer's internal ID from the
  # map of session/name -> ID.
  my $internal_id = delete(
    $heap->{req}{$sender_id}{$req_name}
  );
  return unless defined $internal_id;

  # Clean up parent structures, if necessary,
  # otherwise this component might leak memory.
  delete $heap->{req}{$sender_id}
    unless keys(%{$heap->{req}{$sender_id}});

  my $timer = delete(
    $heap->{timer}{$internal_id}
  );
  return unless defined $timer;

  # Stop the POE timer associated with this
  # cron-like recurring timer.
  $kernel->alarm_remove($timer->{timer_id});

  # The association between the requesting
  # session and this component has been broken.
  # Stop holding it open, at least as far as this
  # timer is concerned.
  $kernel->refcount_decrement(
    $sender_id, "ticking",
  );
}

# A timer has come due.  Determine the session
# that owns it and the event it wishes to be
# posted.  Post the event, and set a new timer
# so this one recurs.

sub handle_wakeup {
  my ($kernel, $heap) = @_[KERNEL, HEAP];
  my $internal_id = $_[ARG0];

  my $timer = $heap->{timer}{$internal_id};

  $kernel->post(
    $timer->{sender_id},
    $timer->{event},
  );

  $timer->{timer_id} = $kernel->delay_set(
    "got_tick", $timer->{interval}, $internal_id,
  );
}

1;