IO-Async-0.67HEADIO-Async-0.67master

3 files changed, 665 insertions, 0 deletions

diff --git a/lib/IO/Async/Timer/Absolute.pm b/lib/IO/Async/Timer/Absolute.pm
new file mode 100644
index 0000000..a925415
--- /dev/null
+++ b/lib/IO/Async/Timer/Absolute.pm
@@ -0,0 +1,142 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk
+
+package IO::Async::Timer::Absolute;
+
+use strict;
+use warnings;
+use base qw( IO::Async::Timer );
+
+our $VERSION = '0.67';
+
+use Carp;
+
+=head1 NAME
+
+C<IO::Async::Timer::Absolute> - event callback at a fixed future time
+
+=head1 SYNOPSIS
+
+ use IO::Async::Timer::Absolute;
+
+ use POSIX qw( mktime );
+
+ use IO::Async::Loop;
+ my $loop = IO::Async::Loop->new;
+
+ my @time = gmtime;
+
+ my $timer = IO::Async::Timer::Absolute->new(
+    time => mktime( 0, 0, 0, $time[3]+1, $time[4], $time[5] ),
+
+    on_expire => sub {
+       print "It's midnight\n";
+       $loop->stop;
+    },
+ );
+
+ $loop->add( $timer );
+
+ $loop->run;
+
+=head1 DESCRIPTION
+
+This subclass of L<IO::Async::Timer> implements one-shot events at a fixed
+time in the future. The object waits for a given timestamp, and invokes its
+callback at that point in the future.
+
+For a C<Timer> object that waits for a delay relative to the time it is
+started, see instead L<IO::Async::Timer::Countdown>.
+
+=cut
+
+=head1 EVENTS
+
+The following events are invoked, either using subclass methods or CODE
+references in parameters:
+
+=head2 on_expire
+
+Invoked when the timer expires.
+
+=cut
+
+=head1 PARAMETERS
+
+The following named parameters may be passed to C<new> or C<configure>:
+
+=head2 on_expire => CODE
+
+CODE reference for the C<on_expire> event.
+
+=head2 time => NUM
+
+The epoch time at which the timer will expire.
+
+Once constructed, the timer object will need to be added to the C<Loop> before
+it will work.
+
+Unlike other timers, it does not make sense to C<start> this object, because
+its expiry time is absolute, and not relative to the time it is started.
+
+=cut
+
+sub configure
+{
+   my $self = shift;
+   my %params = @_;
+
+   if( exists $params{on_expire} ) {
+      my $on_expire = delete $params{on_expire};
+      ref $on_expire or croak "Expected 'on_expire' as a reference";
+
+      $self->{on_expire} = $on_expire;
+      undef $self->{cb}; # Will be lazily constructed when needed
+   }
+
+   if( exists $params{time} ) {
+      my $time = delete $params{time};
+
+      $self->stop if $self->is_running;
+
+      $self->{time} = $time;
+
+      $self->start if !$self->is_running;
+   }
+
+   unless( $self->can_event( 'on_expire' ) ) {
+      croak 'Expected either a on_expire callback or an ->on_expire method';
+   }
+
+   $self->SUPER::configure( %params );
+}
+
+sub _make_cb
+{
+   my $self = shift;
+
+   return $self->_capture_weakself( sub {
+      my $self = shift or return;
+
+      undef $self->{id};
+
+      $self->invoke_event( "on_expire" );
+   } );
+}
+
+sub _make_enqueueargs
+{
+   my $self = shift;
+
+   return at => $self->{time};
+}
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;
diff --git a/lib/IO/Async/Timer/Countdown.pm b/lib/IO/Async/Timer/Countdown.pm
new file mode 100644
index 0000000..201ba42
--- /dev/null
+++ b/lib/IO/Async/Timer/Countdown.pm
@@ -0,0 +1,274 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2009-2012 -- leonerd@leonerd.org.uk
+
+package IO::Async::Timer::Countdown;
+
+use strict;
+use warnings;
+use base qw( IO::Async::Timer );
+
+our $VERSION = '0.67';
+
+use Carp;
+
+=head1 NAME
+
+C<IO::Async::Timer::Countdown> - event callback after a fixed delay
+
+=head1 SYNOPSIS
+
+ use IO::Async::Timer::Countdown;
+
+ use IO::Async::Loop;
+ my $loop = IO::Async::Loop->new;
+
+ my $timer = IO::Async::Timer::Countdown->new(
+    delay => 10,
+
+    on_expire => sub {
+       print "Sorry, your time's up\n";
+       $loop->stop;
+    },
+ );
+
+ $timer->start;
+
+ $loop->add( $timer );
+
+ $loop->run;
+
+=head1 DESCRIPTION
+
+This subclass of L<IO::Async::Timer> implements one-shot fixed delays.
+The object implements a countdown timer, which invokes its callback after the
+given period from when it was started. After it has expired the Timer may be
+started again, when it will wait the same period then invoke the callback
+again. A timer that is currently running may be stopped or reset.
+
+For a C<Timer> object that repeatedly runs a callback at regular intervals,
+see instead L<IO::Async::Timer::Periodic>. For a C<Timer> that invokes its
+callback at a fixed time in the future, see L<IO::Async::Timer::Absolute>.
+
+=cut
+
+=head1 EVENTS
+
+The following events are invoked, either using subclass methods or CODE
+references in parameters:
+
+=head2 on_expire
+
+Invoked when the timer expires.
+
+=cut
+
+=head1 PARAMETERS
+
+The following named parameters may be passed to C<new> or C<configure>:
+
+=head2 on_expire => CODE
+
+CODE reference for the C<on_expire> event.
+
+=head2 delay => NUM
+
+The delay in seconds after starting the timer until it expires. Cannot be
+changed if the timer is running. A timer with a zero delay expires
+"immediately".
+
+=head2 remove_on_expire => BOOL
+
+Optional. If true, remove this timer object from its parent notifier or
+containing loop when it expires. Defaults to false.
+
+Once constructed, the timer object will need to be added to the C<Loop> before
+it will work. It will also need to be started by the C<start> method.
+
+=cut
+
+sub configure
+{
+   my $self = shift;
+   my %params = @_;
+
+   foreach (qw( remove_on_expire )) {
+      $self->{$_} = delete $params{$_} if exists $params{$_};
+   }
+
+   if( exists $params{on_expire} ) {
+      my $on_expire = delete $params{on_expire};
+      ref $on_expire or croak "Expected 'on_expire' as a reference";
+
+      $self->{on_expire} = $on_expire;
+      undef $self->{cb}; # Will be lazily constructed when needed
+   }
+
+   if( exists $params{delay} ) {
+      $self->is_running and croak "Cannot configure 'delay' of a running timer\n";
+
+      my $delay = delete $params{delay};
+      $delay >= 0 or croak "Expected a 'delay' as a non-negative number";
+
+      $self->{delay} = $delay;
+   }
+
+   unless( $self->can_event( 'on_expire' ) ) {
+      croak 'Expected either a on_expire callback or an ->on_expire method';
+   }
+
+   $self->SUPER::configure( %params );
+}
+
+=head1 METHODS
+
+=cut
+
+=head2 $expired = $timer->is_expired
+
+Returns true if the Timer has already expired.
+
+=cut
+
+sub is_expired
+{
+   my $self = shift;
+   return $self->{expired};
+}
+
+sub _make_cb
+{
+   my $self = shift;
+
+   return $self->_capture_weakself( sub {
+      my $self = shift or return;
+
+      undef $self->{id};
+      $self->{expired} = 1;
+
+      $self->remove_from_parent if $self->{remove_on_expire};
+
+      $self->invoke_event( "on_expire" );
+   } );
+}
+
+sub _make_enqueueargs
+{
+   my $self = shift;
+
+   undef $self->{expired};
+   return after => $self->{delay};
+}
+
+=head2 $timer->reset
+
+If the timer is running, restart the countdown period from now. If the timer
+is not running, this method has no effect.
+
+=cut
+
+sub reset
+{
+   my $self = shift;
+
+   my $loop = $self->loop or croak "Cannot reset a Timer that is not in a Loop";
+
+   return if !$self->is_running;
+
+   $self->stop;
+   $self->start;
+}
+
+=head1 EXAMPLES
+
+=head2 Watchdog Timer
+
+Because the C<reset> method restarts a running countdown timer back to its
+full period, it can be used to implement a watchdog timer. This is a timer
+which will not expire provided the method is called at least as often as it
+is configured. If the method fails to be called, the timer will eventually
+expire and run its callback.
+
+For example, to expire an accepted connection after 30 seconds of inactivity:
+
+ ...
+
+ on_accept => sub {
+    my ( $newclient ) = @_;
+
+    my $watchdog = IO::Async::Timer::Countdown->new(
+       delay => 30,
+
+       on_expire => sub {
+          my $self = shift;
+
+          my $stream = $self->parent;
+          $stream->close;
+       },
+    );
+
+    my $stream = IO::Async::Stream->new(
+       handle => $newclient,
+
+       on_read => sub {
+          my ( $self, $buffref, $eof ) = @_;
+          $watchdog->reset;
+
+          ...
+       },
+
+       on_closed => sub {
+          $watchdog->stop;
+       },
+    ) );
+
+    $stream->add_child( $watchdog );
+    $watchdog->start;
+
+    $loop->add( $watchdog );
+ }
+
+Rather than setting up a lexical variable to store the Stream so that the
+Timer's C<on_expire> closure can call C<close> on it, the parent/child
+relationship between the two Notifier objects is used. At the time the Timer
+C<on_expire> closure is invoked, it will have been added as a child notifier
+of the Stream; this means the Timer's C<parent> method will return the Stream
+Notifier. This enables it to call C<close> without needing to capture a
+lexical variable, which would create a cyclic reference.
+
+=head2 Fixed-Delay Repeating Timer
+
+The C<on_expire> event fires a fixed delay after the C<start> method has begun
+the countdown. The C<start> method can be invoked again at some point during
+the C<on_expire> handling code, to create a timer that invokes its code
+regularly a fixed delay after the previous invocation has finished. This
+creates an arrangement similar to an L<IO::Async::Timer::Periodic>, except
+that it will wait until the previous invocation has indicated it is finished,
+before starting the countdown for the next call.
+
+ my $timer = IO::Async::Timer::Countdown->new(
+    delay => 60,
+
+    on_expire => sub {
+       my $self = shift;
+
+       start_some_operation(
+          on_complete => sub { $self->start },
+       );
+    },
+ );
+
+ $timer->start;
+ $loop->add( $timer );
+
+This example invokes the C<start_some_operation> function 60 seconds after the
+previous iteration has indicated it has finished.
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;
diff --git a/lib/IO/Async/Timer/Periodic.pm b/lib/IO/Async/Timer/Periodic.pm
new file mode 100644
index 0000000..f99a43c
--- /dev/null
+++ b/lib/IO/Async/Timer/Periodic.pm
@@ -0,0 +1,249 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2009-2015 -- leonerd@leonerd.org.uk
+
+package IO::Async::Timer::Periodic;
+
+use strict;
+use warnings;
+use base qw( IO::Async::Timer );
+
+our $VERSION = '0.67';
+
+use Carp;
+
+=head1 NAME
+
+C<IO::Async::Timer::Periodic> - event callback at regular intervals
+
+=head1 SYNOPSIS
+
+ use IO::Async::Timer::Periodic;
+
+ use IO::Async::Loop;
+ my $loop = IO::Async::Loop->new;
+
+ my $timer = IO::Async::Timer::Periodic->new(
+    interval => 60,
+
+    on_tick => sub {
+       print "You've had a minute\n";
+    },
+ );
+
+ $timer->start;
+
+ $loop->add( $timer );
+
+ $loop->run;
+
+=head1 DESCRIPTION
+
+This subclass of L<IO::Async::Timer> implements repeating events at regular
+clock intervals. The timing may or may not be subject to how long it takes the
+callback to execute. Iterations may be rescheduled runs at fixed regular
+intervals beginning at the time the timer was started, or by a fixed delay
+after the previous code has finished executing.
+
+For a C<Timer> object that only runs a callback once, after a given delay, see
+instead L<IO::Async::Timer::Countdown>. A Countdown timer can also be used to
+create repeating events that fire at a fixed delay after the previous event
+has finished processing. See als the examples in
+C<IO::Async::Timer::Countdown>.
+
+=cut
+
+=head1 EVENTS
+
+The following events are invoked, either using subclass methods or CODE
+references in parameters:
+
+=head2 on_tick
+
+Invoked on each interval of the timer.
+
+=cut
+
+=head1 PARAMETERS
+
+The following named parameters may be passed to C<new> or C<configure>:
+
+=head2 on_tick => CODE
+
+CODE reference for the C<on_tick> event.
+
+=head2 interval => NUM
+
+The interval in seconds between invocations of the callback or method. Cannot
+be changed if the timer is running.
+
+=head2 first_interval => NUM
+
+Optional. If defined, the interval in seconds after calling the C<start>
+method before the first invocation of the callback or method. Thereafter, the
+regular C<interval> will be used. If not supplied, the first interval will be
+the same as the others.
+
+Even if this value is zero, the first invocation will be made asynchronously,
+by the containing C<Loop> object, and not synchronously by the C<start> method
+itself.
+
+=head2 reschedule => STRING
+
+Optional. Must be one of C<hard>, C<skip> or C<drift>. Defines the algorithm
+used to reschedule the next invocation.
+
+C<hard> schedules each iteration at the fixed interval from the previous
+iteration's schedule time, ensuring a regular repeating event.
+
+C<skip> schedules similarly to C<hard>, but skips over times that have already
+passed. This matters if the duration is particularly short and there's a
+possibility that times may be missed, or if the entire process is stopped and
+resumed by C<SIGSTOP> or similar.
+
+C<drift> schedules each iteration at the fixed interval from the time that the
+previous iteration's event handler returns. This allows it to slowly drift over
+time and become desynchronised with other events of the same interval or
+multiples/fractions of it.
+
+Once constructed, the timer object will need to be added to the C<Loop> before
+it will work. It will also need to be started by the C<start> method.
+
+=cut
+
+sub _init
+{
+   my $self = shift;
+   $self->SUPER::_init( @_ );
+
+   $self->{reschedule} = "hard";
+}
+
+sub configure
+{
+   my $self = shift;
+   my %params = @_;
+
+   if( exists $params{on_tick} ) {
+      my $on_tick = delete $params{on_tick};
+      ref $on_tick or croak "Expected 'on_tick' as a reference";
+
+      $self->{on_tick} = $on_tick;
+      undef $self->{cb}; # Will be lazily constructed when needed
+   }
+
+   if( exists $params{interval} ) {
+      $self->is_running and croak "Cannot configure 'interval' of a running timer\n";
+
+      my $interval = delete $params{interval};
+      $interval > 0 or croak "Expected a 'interval' as a positive number";
+
+      $self->{interval} = $interval;
+   }
+
+   if( exists $params{first_interval} ) {
+      $self->is_running and croak "Cannot configure 'first_interval' of a running timer\n";
+
+      my $first_interval = delete $params{first_interval};
+      $first_interval >= 0 or croak "Expected a 'first_interval' as a non-negative number";
+
+      $self->{first_interval} = $first_interval;
+   }
+
+   if( exists $params{reschedule} ) {
+      my $resched = delete $params{reschedule} || "hard";
+      grep { $_ eq $resched } qw( hard skip drift ) or
+         croak "Expected 'reschedule' to be one of hard, skip, drift";
+
+      $self->{reschedule} = $resched;
+   }
+
+   unless( $self->can_event( 'on_tick' ) ) {
+      croak 'Expected either a on_tick callback or an ->on_tick method';
+   }
+
+   $self->SUPER::configure( %params );
+}
+
+sub _next_interval
+{
+   my $self = shift;
+   return $self->{first_interval} if defined $self->{first_interval};
+   return $self->{interval};
+}
+
+sub start
+{
+   my $self = shift;
+
+   # Only actually define a time if we've got a loop; otherwise it'll just
+   # become start-pending. We'll calculate it properly when it gets added to
+   # the Loop
+   if( my $loop = $self->loop ) {
+      my $now = $loop->time;
+      my $resched = $self->{reschedule};
+
+      if( !defined $self->{next_time} ) {
+         $self->{next_time} = $now + $self->_next_interval;
+      }
+      elsif( $resched eq "hard" ) {
+         $self->{next_time} += $self->_next_interval;
+      }
+      elsif( $resched eq "skip" ) {
+         # How many ticks are needed?
+         my $ticks = POSIX::ceil( $now - $self->{next_time} );
+         # $self->{last_ticks} = $ticks;
+         $self->{next_time} += $self->_next_interval * $ticks;
+      }
+      elsif( $resched eq "drift" ) {
+         $self->{next_time} = $now + $self->_next_interval;
+      }
+   }
+
+   $self->SUPER::start;
+}
+
+sub stop
+{
+   my $self = shift;
+   $self->SUPER::stop;
+
+   undef $self->{next_time};
+}
+
+sub _make_cb
+{
+   my $self = shift;
+
+   return $self->_capture_weakself( sub {
+      my $self = shift or return;
+
+      undef $self->{first_interval};
+
+      undef $self->{id};
+
+      my $ok = eval { $self->invoke_event( on_tick => ); 1 } or
+         my $e = $@;
+
+      # detect ->stop
+      $self->start if defined $self->{next_time};
+
+      die $e if !$ok;
+   } );
+}
+
+sub _make_enqueueargs
+{
+   my $self = shift;
+
+   return at => $self->{next_time};
+}
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;