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