POE::Component::Schedule - Schedule POE events using DateTime::Set iterators

    use POE qw(Component::Schedule);
    use DateTime::Set;

    POE::Session->create(
        inline_states => {
            _start => sub {
                $_[HEAP]{sched} = POE::Component::Schedule->add(
                    $_[SESSION], Tick => DateTime::Set->from_recurrence(
                        after      => DateTime->now,
                        before     => DateTime->now->add(seconds => 3),
                        recurrence => sub {
                            return $_[0]->truncate( to => 'second' )->add( seconds => 1 )
                        },
                    ),
                );
            },
            Tick => sub {
                print 'tick ', scalar localtime, "\n";
            },
            remove_sched => sub {
                # Three ways to remove a schedule
                # The first one is only for API compatibility with POE::Component::Cron
                $_[HEAP]{sched}->delete;
                $_[HEAP]{sched} = undef;
                delete $_[HEAP]{sched};
            },
            _stop => sub {
                print "_stop\n";
            },
        },
    );

    POE::Kernel->run();

    my $sched = POE::Component::Schedule->add(
        $session,
        $event_name,
        $DateTime_Set_iterator,
        @event_args
    );

package POE::Component::Schedule;

use 5.008;

use strict;
use warnings;
use Carp;

our $VERSION = '0.95';

use POE;


BEGIN {
    defined &DEBUG or *DEBUG = sub () { 0 };
}

# Private properties of a schedule ticket
sub PCS_TIMER    () { 0 }  # The POE timer
sub PCS_ITERATOR () { 1 }  # DateTime::Set iterator
sub PCS_SESSION  () { 2 }  # POE session ID
sub PCS_EVENT    () { 3 }  # Event name
sub PCS_ARGS     () { 4 }  # Event args array

# Private constant:
# The name of the counter attached to each session
# We use only one counter for all timers of one session
# All instances of P::C::S will use the same counter for a given session
sub REFCOUNT_COUNTER_NAME () { __PACKAGE__ }

# Scheduling session ID
# This session is a singleton
my $BackEndSession;

# Maps tickets IDs to tickets
my %Tickets = ();
my $LastTicketID = 'a'; # 'b' ... 'z', 'aa' ...

#
# crank up the schedule session
#
sub spawn { ## no critic (Subroutines::RequireArgUnpacking)
    if ( !defined $BackEndSession ) {
	my ($class, %arg)   = @_;
	my $alias = $arg{Alias} || ref $class || $class;

        $BackEndSession = POE::Session->create(
            inline_states => {
                _start => sub {
                    print "# $alias _start\n" if DEBUG;
                    my ($k) = $_[KERNEL];

                    $k->detach_myself;
                    $k->alias_set( $alias );
                    $k->sig( 'SHUTDOWN', 'shutdown' );
                },

                schedule     => \&_schedule,
                client_event => \&_client_event,
                cancel       => \&_cancel,

                shutdown => sub {
                    print "# $alias shutdown\n" if DEBUG;
                    my $k = $_[KERNEL];

                    # Remove all timers of our session
                    # and decrement session references
                    foreach my $alarm ($k->alarm_remove_all()) {
                        my ($name, $time, $t) = @$alarm;
                        $t->[PCS_TIMER] = undef;
                        $k->refcount_decrement($t->[PCS_SESSION], REFCOUNT_COUNTER_NAME);
                    }
                    %Tickets = ();

                    $k->sig_handled();
                },
                _stop => sub {
                    print "# $alias _stop\n" if DEBUG;
                    $BackEndSession = undef;
                },
            },
        )->ID;
    }
    return $BackEndSession;
}

#
# schedule the next event
#  ARG0 is the schedule ticket
#
sub _schedule {
    my ( $k, $t ) = @_[ KERNEL, ARG0];

    #
    # deal with DateTime::Sets that are finite
    #
    my $n = $t->[PCS_ITERATOR]->next;
    unless ($n) {
        # No more events, so release the session
        $k->refcount_decrement($t->[PCS_SESSION], REFCOUNT_COUNTER_NAME);
        $t->[PCS_TIMER] = undef;
        return;
    }

    $t->[PCS_TIMER] = $k->alarm_set( client_event => $n->epoch, $t );
    return $t;
}

#
# handle a client event and schedule the next one
#  ARG0 is the schedule ticket
#
sub _client_event { ## no critic (Subroutines::RequireArgUnpacking)
    my ( $k, $t ) = @_[ KERNEL, ARG0 ];

    $k->post( @{$t}[PCS_SESSION, PCS_EVENT], @{$t->[PCS_ARGS]} );

    return _schedule(@_);
}

#
# cancel an alarm
#
sub _cancel {
    my ( $k, $t ) = @_[ KERNEL, ARG0 ];

    if (defined($t->[PCS_TIMER])) {
        $k->alarm_remove($t->[PCS_TIMER]);
        $k->refcount_decrement($t->[PCS_SESSION], REFCOUNT_COUNTER_NAME);
        $t->[PCS_TIMER] = undef;
    }
    return;
}

#
# Takes a POE::Session, an event name and a DateTime::Set
# Returns a ticket object
#
sub add {

    my ( $class, $session, $event, $iterator, @args ) = @_;

    # Remember only the session ID
    $session = $poe_kernel->alias_resolve($session) unless ref $session;
    defined($session) or croak __PACKAGE__ . "->add: first arg must be an existing POE session ID or alias.";
    $session = $session->ID;

    # We don't want to loose the session until the event has been handled
    $poe_kernel->refcount_increment($session, REFCOUNT_COUNTER_NAME) > 0
      or croak __PACKAGE__ . "->add: first arg must be an existing POE session ID or alias: $!";

    ref $iterator && $iterator->isa('DateTime::Set')
      or croak __PACKAGE__ . "->add: third arg must be a DateTime::Set";

    $class->spawn unless $BackEndSession;

    my $id = $LastTicketID++;
    my $ticket = $Tickets{$id} = [
        undef, # Current alarm id
        $iterator,
        $session,
        $event,
        \@args,
    ];

    $poe_kernel->post( $BackEndSession, schedule => $ticket);

    # We return a kind of smart pointer, so the schedule
    # can be simply destroyed by releasing its object reference
    return bless \$id, ref($class) || $class;
}

sub delete {
    my $id = ${$_[0]};
    return unless exists $Tickets{$id};
    $poe_kernel->post($BackEndSession, cancel => delete $Tickets{$id});
    return;
}

# Releasing the ticket object will delete the ressource
sub DESTROY {
    return $_[0]->delete;
}

{
    no warnings;
    *new = \&add;
}

1;
__END__