File Coverage

blib/lib/POE/Component/Schedule.pm

Criterion	Covered	Total	%
statement	37	75	49.3
branch	10	20	50.0
condition	3	9	33.3
subroutine	11	17	64.7
pod	3	3	100.0
total	64	124	51.6

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__