1package POE::Component::Schedule;
2
3use 5.008;
4
5use strict;
6use warnings;
7use Carp;
8
9our $VERSION = '0.95';
10
11use POE;
12
13
14BEGIN {
15    defined &DEBUG or *DEBUG = sub () { 0 };
16}
17
18# Private properties of a schedule ticket
19sub PCS_TIMER    () { 0 }  # The POE timer
20sub PCS_ITERATOR () { 1 }  # DateTime::Set iterator
21sub PCS_SESSION  () { 2 }  # POE session ID
22sub PCS_EVENT    () { 3 }  # Event name
23sub PCS_ARGS     () { 4 }  # Event args array
24
25# Private constant:
26# The name of the counter attached to each session
27# We use only one counter for all timers of one session
28# All instances of P::C::S will use the same counter for a given session
29sub REFCOUNT_COUNTER_NAME () { __PACKAGE__ }
30
31# Scheduling session ID
32# This session is a singleton
33my $BackEndSession;
34
35# Maps tickets IDs to tickets
36my %Tickets = ();
37my $LastTicketID = 'a'; # 'b' ... 'z', 'aa' ...
38
39#
40# crank up the schedule session
41#
42sub spawn { ## no critic (Subroutines::RequireArgUnpacking)
43    if ( !defined $BackEndSession ) {
44	my ($class, %arg)   = @_;
45	my $alias = $arg{Alias} || ref $class || $class;
46
47        $BackEndSession = POE::Session->create(
48            inline_states => {
49                _start => sub {
50                    print "# $alias _start\n" if DEBUG;
51                    my ($k) = $_[KERNEL];
52
53                    $k->detach_myself;
54                    $k->alias_set( $alias );
55                    $k->sig( 'SHUTDOWN', 'shutdown' );
56                },
57
58                schedule     => \&_schedule,
59                client_event => \&_client_event,
60                cancel       => \&_cancel,
61
62                shutdown => sub {
63                    print "# $alias shutdown\n" if DEBUG;
64                    my $k = $_[KERNEL];
65
66                    # Remove all timers of our session
67                    # and decrement session references
68                    foreach my $alarm ($k->alarm_remove_all()) {
69                        my ($name, $time, $t) = @$alarm;
70                        $t->[PCS_TIMER] = undef;
71                        $k->refcount_decrement($t->[PCS_SESSION], REFCOUNT_COUNTER_NAME);
72                    }
73                    %Tickets = ();
74
75                    $k->sig_handled();
76                },
77                _stop => sub {
78                    print "# $alias _stop\n" if DEBUG;
79                    $BackEndSession = undef;
80                },
81            },
82        )->ID;
83    }
84    return $BackEndSession;
85}
86
87#
88# schedule the next event
89#  ARG0 is the schedule ticket
90#
91sub _schedule {
92    my ( $k, $t ) = @_[ KERNEL, ARG0];
93
94    #
95    # deal with DateTime::Sets that are finite
96    #
97    my $n = $t->[PCS_ITERATOR]->next;
98    unless ($n) {
99        # No more events, so release the session
100        $k->refcount_decrement($t->[PCS_SESSION], REFCOUNT_COUNTER_NAME);
101        $t->[PCS_TIMER] = undef;
102        return;
103    }
104
105    $t->[PCS_TIMER] = $k->alarm_set( client_event => $n->epoch, $t );
106    return $t;
107}
108
109#
110# handle a client event and schedule the next one
111#  ARG0 is the schedule ticket
112#
113sub _client_event { ## no critic (Subroutines::RequireArgUnpacking)
114    my ( $k, $t ) = @_[ KERNEL, ARG0 ];
115
116    $k->post( @{$t}[PCS_SESSION, PCS_EVENT], @{$t->[PCS_ARGS]} );
117
118    return _schedule(@_);
119}
120
121#
122# cancel an alarm
123#
124sub _cancel {
125    my ( $k, $t ) = @_[ KERNEL, ARG0 ];
126
127    if (defined($t->[PCS_TIMER])) {
128        $k->alarm_remove($t->[PCS_TIMER]);
129        $k->refcount_decrement($t->[PCS_SESSION], REFCOUNT_COUNTER_NAME);
130        $t->[PCS_TIMER] = undef;
131    }
132    return;
133}
134
135#
136# Takes a POE::Session, an event name and a DateTime::Set
137# Returns a ticket object
138#
139sub add {
140
141    my ( $class, $session, $event, $iterator, @args ) = @_;
142
143    # Remember only the session ID
144    $session = $poe_kernel->alias_resolve($session) unless ref $session;
145    defined($session) or croak __PACKAGE__ . "->add: first arg must be an existing POE session ID or alias.";
146    $session = $session->ID;
147
148    # We don't want to loose the session until the event has been handled
149    $poe_kernel->refcount_increment($session, REFCOUNT_COUNTER_NAME) > 0
150      or croak __PACKAGE__ . "->add: first arg must be an existing POE session ID or alias: $!";
151
152    ref $iterator && $iterator->isa('DateTime::Set')
153      or croak __PACKAGE__ . "->add: third arg must be a DateTime::Set";
154
155    $class->spawn unless $BackEndSession;
156
157    my $id = $LastTicketID++;
158    my $ticket = $Tickets{$id} = [
159        undef, # Current alarm id
160        $iterator,
161        $session,
162        $event,
163        \@args,
164    ];
165
166    $poe_kernel->post( $BackEndSession, schedule => $ticket);
167
168    # We return a kind of smart pointer, so the schedule
169    # can be simply destroyed by releasing its object reference
170    return bless \$id, ref($class) || $class;
171}
172
173sub delete {
174    my $id = ${$_[0]};
175    return unless exists $Tickets{$id};
176    $poe_kernel->post($BackEndSession, cancel => delete $Tickets{$id});
177    return;
178}
179
180# Releasing the ticket object will delete the ressource
181sub DESTROY {
182    return $_[0]->delete;
183}
184
185{
186    no warnings;
187    *new = \&add;
188}
189
1901;
191__END__
192
193=head1 NAME
194
195POE::Component::Schedule - Schedule POE events using DateTime::Set iterators
196
197=head1 SYNOPSIS
198
199    use POE qw(Component::Schedule);
200    use DateTime::Set;
201
202    POE::Session->create(
203        inline_states => {
204            _start => sub {
205                $_[HEAP]{sched} = POE::Component::Schedule->add(
206                    $_[SESSION], Tick => DateTime::Set->from_recurrence(
207                        after      => DateTime->now,
208                        before     => DateTime->now->add(seconds => 3),
209                        recurrence => sub {
210                            return $_[0]->truncate( to => 'second' )->add( seconds => 1 )
211                        },
212                    ),
213                );
214            },
215            Tick => sub {
216                print 'tick ', scalar localtime, "\n";
217            },
218            remove_sched => sub {
219                # Three ways to remove a schedule
220                # The first one is only for API compatibility with POE::Component::Cron
221                $_[HEAP]{sched}->delete;
222                $_[HEAP]{sched} = undef;
223                delete $_[HEAP]{sched};
224            },
225            _stop => sub {
226                print "_stop\n";
227            },
228        },
229    );
230
231    POE::Kernel->run();
232
233=head1 DESCRIPTION
234
235This component encapsulates a session that sends events to client sessions
236on a schedule as defined by a DateTime::Set iterator.
237
238=head1 POE::Component::Schedule METHODS
239
240=head2 spawn(Alias => I<name>)
241
242Start up the PoCo::Schedule background session with the given alias. Returns
243the back-end session handle.
244
245No need to call this in normal use, C<add()> and C<new()> all crank
246one of these up if it is needed.
247
248=head2 add(I<$session>, I<$event_name>, I<$iterator>, I<@event_args>)
249
250    my $sched = POE::Component::Schedule->add(
251        $session,
252        $event_name,
253        $DateTime_Set_iterator,
254        @event_args
255    );
256
257Add a set of events to the scheduler.
258
259Returns a schedule handle. The event is automatically deleted when the handle
260is not referenced anymore.
261
262=head2 new(I<$session>, I<$event_name>, I<$iterator>, I<@event_args>)
263
264C<new()> is an alias for C<add()>.
265
266=head1 SCHEDULE HANDLE METHODS
267
268=head2 delete()
269
270Removes a schedule using the handle returned from C<add()> or C<new()>.
271
272B<DEPRECATED>: Schedules are now automatically deleted when they are not
273referenced anymore. So just setting the container variable to C<undef> will
274delete the schedule.
275
276=head1 SEE ALSO
277
278L<POE>, L<DateTime::Set>, L<POE::Component::Cron>.
279
280=head1 SUPPORT
281
282You can look for information at:
283
284=over 4
285
286=item * RT: CPAN's request tracker
287
288L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=POE-Component-Schedule>:
289post bug report there.
290
291=item * CPAN Ratings
292
293L<http://cpanratings.perl.org/p/POE-Component-Schedule>:
294if you use this distibution, please add comments on your experience for other
295users.
296
297=item * Search CPAN
298
299L<http://search.cpan.org/dist/POE-Component-Schedule/>
300
301=item * AnnoCPAN: Annotated CPAN documentation
302
303L<http://annocpan.org/dist/POE-Component-Schedule>
304
305=back
306
307
308=head1 ACKNOWLEDGMENT & HISTORY
309
310This module was a friendly fork of L<POE::Component::Cron> to extract the
311generic parts and isolate the Cron specific code in order to reduce
312dependencies on other CPAN modules.
313
314See L<https://rt.cpan.org/Ticket/Display.html?id=44442>.
315
316The orignal author of POE::Component::Cron is Chris Fedde.
317
318POE::Component::Cron is now implemented as a class that inherits from
319POE::Component::Schedule.
320
321Most of the POE::Component::Schedule internals have since been rewritten in
3220.91_01 and we have now a complete test suite.
323
324=head1 AUTHORS
325
326=over 4
327
328=item Olivier MenguE<eacute>, C<<< dolmen@cpan.org >>>
329
330=item Chris Fedde, C<<< cfedde@cpan.org >>>
331
332=back
333
334=head1 COPYRIGHT AND LICENSE
335
336=over 4
337
338=item Copyright E<copy> 2009-2010 Olivier MenguE<eacute>.
339
340=item Copyright E<copy> 2007-2008 Chris Fedde.
341
342=back
343
344This library is free software; you can redistribute it and/or modify
345it under the same terms as Perl itself, either Perl version 5.8.3 or,
346at your option, any later version of Perl 5 you may have available.
347
348=cut
349