Acme-Sort-Sleep
view release on metacpan or search on metacpan
---
abstract: 'IO::Async timer based sorting algorithm'
author:
- 'Mitch McCracken <mrmccrac@gmail.com>'
build_requires:
Test::Exception: '0'
Test::More: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.007, CPAN::Meta::Converter version 2.150005'
license: artistic_2
Makefile.PL view on Meta::CPAN
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.007.
use strict;
use warnings;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
"ABSTRACT" => "IO::Async timer based sorting algorithm",
"AUTHOR" => "Mitch McCracken <mrmccrac\@gmail.com>",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
},
"DISTNAME" => "Acme-Sort-Sleep",
"LICENSE" => "artistic_2",
"NAME" => "Acme::Sort::Sleep",
"PREREQ_PM" => {
"Exporter" => 0,
"IO::Async::Loop" => 0,
# NAME
Acme::Sort::Sleep - IO::Async timer based sorting algorithm
# SYNOPSIS
use Acme::Sort::Sleep qw( sleepsort );
my @sorted = sleepsort( qw( 3 1 3.37 0 ) );
# DISCUSSION
[https://www.reddit.com/r/programming/comments/2qeg28/4chan\_sleep\_sort/](https://www.reddit.com/r/programming/comments/2qeg28/4chan_sleep_sort/)
lib/Acme/Sort/Sleep.pm view on Meta::CPAN
# ABSTRACT: IO::Async timer based sorting algorithm
package Acme::Sort::Sleep;
use strict;
use warnings;
use IO::Async::Loop;
use IO::Async::Timer::Countdown;
use Scalar::Util qw( looks_like_number );
lib/Acme/Sort/Sleep.pm view on Meta::CPAN
my $loop = IO::Async::Loop->new;
for my $num ( @unsorted ) {
# only allow positive numbers
die ERROR_STR unless defined $num;
die ERROR_STR unless looks_like_number $num;
die ERROR_STR unless $num >= 0;
my $timer = IO::Async::Timer::Countdown->new(
delay => $num,
remove_on_expire => 1,
on_expire => sub {
push @sorted, $num;
# no more timers/numbers left to sort
$loop->stop unless $loop->notifiers;
},
);
$timer->start;
$loop->add( $timer );
}
$loop->run;
return @sorted;
}
1;
lib/Acme/Sort/Sleep.pod view on Meta::CPAN
=head1 NAME
Acme::Sort::Sleep - IO::Async timer based sorting algorithm
=head1 SYNOPSIS
use Acme::Sort::Sleep qw( sleepsort );
my @sorted = sleepsort( qw( 3 1 3.37 0 ) );
=head1 DISCUSSION
L<https://www.reddit.com/r/programming/comments/2qeg28/4chan_sleep_sort/>
local/lib/perl5/IO/Async.pm view on Meta::CPAN
);
$loop->run;
=head1 DESCRIPTION
This collection of modules allows programs to be written that perform
asynchronous filehandle IO operations. A typical program using them would
consist of a single subclass of L<IO::Async::Loop> to act as a container of
other objects, which perform the actual IO work required by the program. As
well as IO handles, the loop also supports timers and signal handlers, and
includes more higher-level functionality built on top of these basic parts.
Because there are a lot of classes in this collection, the following overview
gives a brief description of each.
=head2 Notifiers
The base class of all the event handling subclasses is L<IO::Async::Notifier>.
It does not perform any IO operations itself, but instead acts as a base class
to build the specific IO functionality upon. It can also coordinate a
local/lib/perl5/IO/Async.pm view on Meta::CPAN
maintains an outgoing packet queue, and informs of packet receipt using a
callback or method.
The L<IO::Async::Listener> class is another subclass of L<IO::Async::Handle>
which facilitates the use of C<listen(2)>-mode sockets. When a new connection
is available on the socket it will C<accept(2)> it and pass the new client
socket to its callback function.
=head2 Timers
An L<IO::Async::Timer::Absolute> object represents a timer that expires at a
given absolute time in the future.
An L<IO::Async::Timer::Countdown> object represents a count time timer, which
will invoke a callback after a given delay. It can be stopped and restarted.
An L<IO::Async::Timer::Periodic> object invokes a callback at regular intervals
from its initial start time. It is reliable and will not drift due to the time
taken to run the callback.
The L<IO::Async::Loop> also supports methods for managing timed events on a
lower level. Events may be absolute, or relative in time to the time they are
installed.
local/lib/perl5/IO/Async.pm view on Meta::CPAN
An L<IO::Async::PID> object invokes its event when a given child process
exits. An L<IO::Async::Process> object can start a new child process running
either a given block of code, or executing a given command, set up pipes on
its filehandles, write to or read from these pipes, and invoke its event when
the child process exits.
=head2 Loops
The L<IO::Async::Loop> object class represents an abstract collection of
L<IO::Async::Notifier> objects, and manages the actual filehandle IO
watchers, timers, signal handlers, and other functionality. It performs all
of the abstract collection management tasks, and leaves the actual OS
interactions to a particular subclass for the purpose.
L<IO::Async::Loop::Poll> uses an L<IO::Poll> object for this test.
L<IO::Async::Loop::Select> uses the C<select(2)> syscall.
Other subclasses of loop may appear on CPAN under their own dists; see the
L</SEE ALSO> section below for more detail.
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
if( keys %worker_params ) {
foreach my $worker ( $self->_worker_objects ) {
$worker->configure( %worker_params );
}
}
if( exists $params{idle_timeout} ) {
my $timeout = delete $params{idle_timeout};
if( !$timeout ) {
$self->remove_child( delete $self->{idle_timer} ) if $self->{idle_timer};
}
elsif( my $idle_timer = $self->{idle_timer} ) {
$idle_timer->configure( delay => $timeout );
}
else {
$self->{idle_timer} = IO::Async::Timer::Countdown->new(
delay => $timeout,
on_expire => $self->_capture_weakself( sub {
my $self = shift or return;
my $workers = $self->{workers};
# Shut down atmost one idle worker, starting from the highest
# ID. Since we search from lowest to assign work, this tries
# to ensure we'll shut down the least useful ones first,
# keeping more useful ones in memory (page/cache warmth, etc..)
foreach my $id ( reverse sort keys %$workers ) {
next if $workers->{$id}{busy};
$workers->{$id}->stop;
last;
}
# Still more?
$self->{idle_timer}->start if $self->workers_idle > $self->{min_workers};
} ),
);
$self->add_child( $self->{idle_timer} );
}
}
foreach (qw( min_workers max_workers )) {
$self->{$_} = delete $params{$_} if exists $params{$_};
# TODO: something about retuning
}
my $need_restart;
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
}
sub _call_worker
{
my $self = shift;
my ( $worker, $type, $args ) = @_;
my $future = $worker->call( $type, $args );
if( $self->workers_idle == 0 ) {
$self->{idle_timer}->stop if $self->{idle_timer};
}
return $future;
}
sub _dispatch_pending
{
my $self = shift;
while( my $next = shift @{ $self->{pending_queue} } ) {
my $worker = $self->_get_worker or return;
next if $next->is_cancelled;
$self->debug_printf( "UNQUEUE" );
$next->done( $self, $worker );
return;
}
if( $self->workers_idle > $self->{min_workers} ) {
$self->{idle_timer}->start if $self->{idle_timer} and !$self->{idle_timer}->is_running;
}
}
package # hide from indexer
IO::Async::Function::Worker;
use base qw( IO::Async::Routine );
use IO::Async::Channel;
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
use warnings;
our $VERSION = '0.70';
# When editing this value don't forget to update the docs below
use constant NEED_API_VERSION => '0.33';
# Base value but some classes might override
use constant _CAN_ON_HANGUP => 0;
# Most Loop implementations do not accurately handle sub-second timers.
# This only matters for unit tests
use constant _CAN_SUBSECOND_ACCURATELY => 0;
# Does the loop implementation support IO_ASYNC_WATCHDOG?
use constant _CAN_WATCHDOG => 0;
# Watchdog configuration constants
use constant WATCHDOG_ENABLE => $ENV{IO_ASYNC_WATCHDOG};
use constant WATCHDOG_INTERVAL => $ENV{IO_ASYNC_WATCHDOG_INTERVAL} || 10;
use constant WATCHDOG_SIGABRT => $ENV{IO_ASYNC_WATCHDOG_SIGABRT};
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
$loop->run;
=head1 DESCRIPTION
This module provides an abstract class which implements the core loop of the
L<IO::Async> framework. Its primary purpose is to store a set of
L<IO::Async::Notifier> objects or subclasses of them. It handles all of the
lower-level set manipulation actions, and leaves the actual IO readiness
testing/notification to the concrete class that implements it. It also
provides other functionality such as signal handling, child process managing,
and timers.
See also the two bundled Loop subclasses:
=over 4
=item L<IO::Async::Loop::Select>
=item L<IO::Async::Loop::Poll>
=back
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
deferrals => [],
os => {}, # A generic scratchpad for IO::Async::OS to store whatever it wants
}, $class;
# It's possible this is a specific subclass constructor. We still want the
# magic IO::Async::Loop->new constructor to yield this if it's the first
# one
our $ONE_TRUE_LOOP ||= $self;
# Legacy support - temporary until all CPAN classes are updated; bump NEEDAPI version at that point
my $old_timer = $self->can( "enqueue_timer" ) != \&enqueue_timer;
if( $old_timer != ( $self->can( "cancel_timer" ) != \&cancel_timer ) ) {
die "$class should overload both ->enqueue_timer and ->cancel_timer, or neither";
}
if( $old_timer ) {
warnings::warnif( deprecated => "Enabling old_timer workaround for old loop class " . $class );
}
$self->{old_timer} = $old_timer;
return $self;
}
=head1 MAGIC CONSTRUCTOR
=head2 new
$loop = IO::Async::Loop->new
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
$self->loop_once until _all_ready @futures;
}
=head2 delay_future
$loop->delay_future( %args )->get
Returns a new L<IO::Async::Future> instance which will become done at a given
point in time. The C<%args> should contain an C<at> or C<after> key as per the
C<watch_time> method. The returned future may be cancelled to cancel the
timer. At the alloted time the future will succeed with an empty result list.
=cut
sub delay_future
{
my $self = shift;
my %args = @_;
my $future = $self->new_future;
my $id = $self->watch_time( %args,
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
return $future;
}
=head2 timeout_future
$loop->timeout_future( %args )->get
Returns a new L<IO::Async::Future> instance which will fail at a given point
in time. The C<%args> should contain an C<at> or C<after> key as per the
C<watch_time> method. The returned future may be cancelled to cancel the
timer. At the alloted time, the future will fail with the string C<"Timeout">.
=cut
sub timeout_future
{
my $self = shift;
my %args = @_;
my $future = $self->new_future;
my $id = $self->watch_time( %args,
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
}
=head2 watch_time
$id = $loop->watch_time( %args )
This method installs a callback which will be called at the specified time.
The time may either be specified as an absolute value (the C<at> key), or
as a delay from the time it is installed (the C<after> key).
The returned C<$id> value can be used to identify the timer in case it needs
to be cancelled by the C<unwatch_time> method. Note that this value may be
an object reference, so if it is stored, it should be released after it has
been fired or cancelled, so the object itself can be freed.
The C<%params> hash takes the following keys:
=over 8
=item at => NUM
The absolute system timestamp to run the event.
=item after => NUM
The delay after now at which to run the event, if C<at> is not supplied. A
zero or negative delayed timer should be executed as soon as possible; the
next time the C<loop_once> method is invoked.
=item now => NUM
The time to consider as now if calculating an absolute time based on C<after>;
defaults to C<time()> if not specified.
=item code => CODE
CODE reference to the continuation to run at the allotted time.
=back
Either one of C<at> or C<after> is required.
For more powerful timer functionality as a L<IO::Async::Notifier> (so it can
be used as a child within another Notifier), see instead the
L<IO::Async::Timer> object and its subclasses.
These C<*_time> methods are optional; a subclass may implement neither or both
of them. If it implements neither, then the base class will manage a queue of
timer events. This queue should be handled by the C<loop_once> method
implemented by the subclass, using the C<_adjust_timeout> and
C<_manage_queues> methods.
This is the newer version of the API, replacing C<enqueue_timer>. It is
unspecified how this method pair interacts with the older
C<enqueue/requeue/cancel_timer> triplet.
=cut
sub watch_time
{
my $self = shift;
my %args = @_;
# Renamed args
if( exists $args{after} ) {
$args{delay} = delete $args{after};
}
elsif( exists $args{at} ) {
$args{time} = delete $args{at};
}
else {
croak "Expected one of 'at' or 'after'";
}
if( $self->{old_timer} ) {
$self->enqueue_timer( %args );
}
else {
my $timequeue = $self->{timequeue} ||= $self->__new_feature( "IO::Async::Internals::TimeQueue" );
my $time = $self->_build_time( %args );
my $code = $args{code};
$timequeue->enqueue( time => $time, code => $code );
}
}
=head2 unwatch_time
$loop->unwatch_time( $id )
Removes a timer callback previously created by C<watch_time>.
This is the newer version of the API, replacing C<cancel_timer>. It is
unspecified how this method pair interacts with the older
C<enqueue/requeue/cancel_timer> triplet.
=cut
sub unwatch_time
{
my $self = shift;
my ( $id ) = @_;
if( $self->{old_timer} ) {
$self->cancel_timer( $id );
}
else {
my $timequeue = $self->{timequeue} ||= $self->__new_feature( "IO::Async::Internals::TimeQueue" );
$timequeue->cancel( $id );
}
}
sub _build_time
{
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
$time = $now + $params{delay};
}
else {
croak "Expected either 'time' or 'delay' keys";
}
return $time;
}
=head2 enqueue_timer
$id = $loop->enqueue_timer( %params )
An older version of C<watch_time>. This method should not be used in new code
but is retained for legacy purposes. For simple watch/unwatch behaviour use
instead the new C<watch_time> method; though note it has differently-named
arguments. For requeueable timers, consider using an
L<IO::Async::Timer::Countdown> or L<IO::Async::Timer::Absolute> instead.
=cut
sub enqueue_timer
{
my $self = shift;
my ( %params ) = @_;
# Renamed args
$params{after} = delete $params{delay} if exists $params{delay};
$params{at} = delete $params{time} if exists $params{time};
my $code = $params{code};
return [ $self->watch_time( %params ), $code ];
}
=head2 cancel_timer
$loop->cancel_timer( $id )
An older version of C<unwatch_time>. This method should not be used in new
code but is retained for legacy purposes.
=cut
sub cancel_timer
{
my $self = shift;
my ( $id ) = @_;
$self->unwatch_time( $id->[0] );
}
=head2 requeue_timer
$newid = $loop->requeue_timer( $id, %params )
Reschedule an existing timer, moving it to a new time. The old timer is
removed and will not be invoked.
The C<%params> hash takes the same keys as C<enqueue_timer>, except for the
C<code> argument.
The requeue operation may be implemented as a cancel + enqueue, which may
mean the ID changes. Be sure to store the returned C<$newid> value if it is
required.
This method should not be used in new code but is retained for legacy
purposes. For requeueable, consider using an L<IO::Async::Timer::Countdown> or
L<IO::Async::Timer::Absolute> instead.
=cut
sub requeue_timer
{
my $self = shift;
my ( $id, %params ) = @_;
$self->unwatch_time( $id->[0] );
return $self->enqueue_timer( %params, code => $id->[1] );
}
=head2 watch_idle
$id = $loop->watch_idle( %params )
This method installs a callback which will be called at some point in the near
future.
The C<%params> hash takes the following keys:
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
required by specific subclasses to implement the loop functionality. The use
cases of each will be documented in the above section.
=cut
=head2 _adjust_timeout
$loop->_adjust_timeout( \$timeout )
Shortens the timeout value passed in the scalar reference if it is longer in
seconds than the time until the next queued event on the timer queue. If there
are pending idle handlers, the timeout is reduced to zero.
=cut
sub _adjust_timeout
{
my $self = shift;
my ( $timeref, %params ) = @_;
$$timeref = 0, return if @{ $self->{deferrals} };
if( defined $self->{sigproxy} and !$params{no_sigwait} ) {
$$timeref = $MAX_SIGWAIT_TIME if !defined $$timeref or $$timeref > $MAX_SIGWAIT_TIME;
}
if( !HAVE_SIGNALS and keys %{ $self->{childwatches} } ) {
$$timeref = $MAX_CHILDWAIT_TIME if !defined $$timeref or $$timeref > $MAX_CHILDWAIT_TIME;
}
my $timequeue = $self->{timequeue};
return unless defined $timequeue;
my $nexttime = $timequeue->next_time;
return unless defined $nexttime;
my $now = exists $params{now} ? $params{now} : $self->time;
my $timer_delay = $nexttime - $now;
if( $timer_delay < 0 ) {
$$timeref = 0;
}
elsif( !defined $$timeref or $timer_delay < $$timeref ) {
$$timeref = $timer_delay;
}
}
=head2 _manage_queues
$loop->_manage_queues
Checks the timer queue for callbacks that should have been invoked by now, and
runs them all, removing them from the queue. It also invokes all of the
pending idle handlers. Any new idle handlers installed by these are not
invoked yet; they will wait for the next time this method is called.
=cut
sub _manage_queues
{
my $self = shift;
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
A well-behaved L<IO::Async> program should spend almost all of its time
blocked on input using the underlying C<IO::Async::Loop> instance. The stall
watchdog is an optional debugging feature to help detect CPU spinlocks and
other bugs, where control is not returned to the loop every so often.
If the watchdog is enabled and an event handler consumes more than a given
amount of real time before returning to the event loop, it will be interrupted
by printing a stack trace and terminating the program. The watchdog is only in
effect while the loop itself is not blocking; it won't fail simply because the
loop instance is waiting for input or timers.
It is implemented using C<SIGALRM>, so if enabled, this signal will no longer
be available to user code. (Though in any case, most uses of C<alarm()> and
C<SIGALRM> are better served by one of the L<IO::Async::Timer> subclasses).
The following environment variables control its behaviour.
=over 4
=item IO_ASYNC_WATCHDOG => BOOL
local/lib/perl5/IO/Async/Loop/Select.pm view on Meta::CPAN
Scalar reference to the timeout value
=back
=cut
sub pre_select
{
my $self = shift;
my ( $readref, $writeref, $exceptref, $timeref ) = @_;
# BITWISE operations
$$readref |= $self->{rvec};
$$writeref |= $self->{wvec};
$$exceptref |= $self->{evec};
$self->_adjust_timeout( $timeref );
$$timeref = 0 if FAKE_ISREG_READY and length $self->{avec};
# Round up to nearest millisecond
if( $$timeref ) {
my $mils = $$timeref * 1000;
my $fraction = $mils - int $mils;
$$timeref += ( 1 - $fraction ) / 1000 if $fraction;
}
return;
}
=head2 post_select
$loop->post_select( $readvec, $writevec, $exceptvec )
This method checks the returned bitvectors from a C<select> call, and calls
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
=head1 DESCRIPTION
This module contains a collection of test functions for running acceptance
tests on L<IO::Async::Loop> subclasses. It is provided as a facility for
authors of such subclasses to ensure that the code conforms to the Loop API
required by L<IO::Async>.
=head1 TIMING
Certain tests require the use of timers or timed delays. Normally these are
counted in units of seconds. By setting the environment variable
C<TEST_QUICK_TIMERS> to some true value, these timers run 10 times quicker,
being measured in units of 0.1 seconds instead. This value may be useful when
running the tests interactively, to avoid them taking too long. The slower
timers are preferred on automated smoke-testing machines, to help guard
against false negatives reported simply because of scheduling delays or high
system load while testing.
TEST_QUICK_TIMERS=1 ./Build test
=cut
=head1 FUNCTIONS
=cut
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
is( $writeready, 1, 'regular file is writeready' );
$loop->unwatch_io(
handle => $F,
on_read_ready => 1,
on_write_ready => 1,
);
}
}
=head2 timer
Tests the Loop's ability to handle timer events
=cut
use constant count_tests_timer => 21;
sub run_tests_timer
{
my $done = 0;
# New watch/unwatch API
cmp_ok( abs( $loop->time - time ), "<", 0.1, '$loop->time gives the current time' );
$loop->watch_time( after => 2 * AUT, code => sub { $done = 1; } );
is_oneref( $loop, '$loop has refcount 1 after watch_time' );
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
$loop->loop_once( 2 * AUT );
ok( !$cancelled_fired, 'unwatched watch_time does not fire' );
$loop->watch_time( after => -1, code => sub { $done = 1 } );
$done = 0;
time_between {
$loop->loop_once while !$done;
} 0, 0.1, 'loop_once while waiting for negative interval timer';
{
my $done;
my $id;
$id = $loop->watch_time( after => 1 * AUT, code => sub {
$loop->unwatch_time( $id ); undef $id;
});
$loop->watch_time( after => 1.1 * AUT, code => sub {
$done++;
});
wait_for { $done };
is( $done, 1, 'Other timers still fire after self-cancelling one' );
}
# Legacy enqueue/requeue/cancel API
$done = 0;
$loop->enqueue_timer( delay => 2 * AUT, code => sub { $done = 1; } );
is_oneref( $loop, '$loop has refcount 1 after enqueue_timer' );
time_between {
my $now = time;
$loop->loop_once( 5 * AUT );
# poll might have returned just a little early, such that the TimerQueue
# doesn't think anything is ready yet. We need to handle that case.
while( !$done ) {
die "It should have been ready by now" if( time - $now > 5 * AUT );
$loop->loop_once( 0.1 * AUT );
}
} 1.5, 2.5, 'loop_once(5) while waiting for timer';
SKIP: {
skip "Unable to handle sub-second timers accurately", 3 unless $loop->_CAN_SUBSECOND_ACCURATELY;
# Check that short delays are achievable in one ->loop_once call
foreach my $delay ( 0.001, 0.01, 0.1 ) {
my $done;
my $count = 0;
my $start = time;
$loop->enqueue_timer( delay => $delay, code => sub { $done++ } );
while( !$done ) {
$loop->loop_once( 1 );
$count++;
last if time - $start > 5; # bailout
}
is( $count, 1, "One ->loop_once(1) sufficient for a single $delay second timer" );
}
}
$cancelled_fired = 0;
$id = $loop->enqueue_timer( delay => 1 * AUT, code => sub { $cancelled_fired = 1 } );
$loop->cancel_timer( $id );
undef $id;
$loop->loop_once( 2 * AUT );
ok( !$cancelled_fired, 'cancelled timer does not fire' );
$id = $loop->enqueue_timer( delay => 1 * AUT, code => sub { $done = 2; } );
$id = $loop->requeue_timer( $id, delay => 2 * AUT );
$done = 0;
time_between {
$loop->loop_once( 1 * AUT );
is( $done, 0, '$done still 0 so far' );
my $now = time;
$loop->loop_once( 5 * AUT );
# poll might have returned just a little early, such that the TimerQueue
# doesn't think anything is ready yet. We need to handle that case.
while( !$done ) {
die "It should have been ready by now" if( time - $now > 5 * AUT );
$loop->loop_once( 0.1 * AUT );
}
} 1.5, 2.5, 'requeued timer of delay 2';
is( $done, 2, '$done is 2 after requeued timer' );
}
=head2 signal
Tests the Loop's ability to watch POSIX signals
=cut
use constant count_tests_signal => 14;
sub run_tests_signal
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
$id = $loop->watch_idle( when => 'later', code => sub { $called = 20 } );
$loop->unwatch_idle( $id );
time_between { $loop->loop_once( 1 * AUT ) } 0.5, 1.5, 'loop_once(1) with unwatched deferral';
is( $called, 2, 'unwatched deferral not called' );
$id = $loop->watch_idle( when => 'later', code => sub { $called = 3 } );
my $timer_id = $loop->watch_time( after => 5, code => sub {} );
$loop->loop_once( 1 );
is( $called, 3, '$loop->later still invoked with enqueued timer' );
$loop->unwatch_time( $timer_id );
$loop->later( sub { $called = 4 } );
$loop->loop_once( 1 );
is( $called, 4, '$loop->later shortcut works' );
}
=head2 child
local/lib/perl5/IO/Async/Test.pm view on Meta::CPAN
=cut
sub wait_for(&)
{
my ( $cond ) = @_;
my ( undef, $callerfile, $callerline ) = caller;
my $timedout = 0;
my $timerid = $loop->watch_time(
after => 10,
code => sub { $timedout = 1 },
);
$loop->loop_once( 1 ) while !$cond->() and !$timedout;
if( $timedout ) {
die "Nothing was ready after 10 second wait; called at $callerfile line $callerline\n";
}
else {
$loop->unwatch_time( $timerid );
}
}
=head2 wait_for_stream
wait_for_stream { COND } $handle, $buffer
As C<wait_for>, but will also watch the given IO handle for readability, and
whenever it is readable will read bytes in from it into the given buffer. The
buffer is NOT initialised when the function is entered, in case data remains
local/lib/perl5/IO/Async/Timer.pm view on Meta::CPAN
=back
=cut
=head1 CONSTRUCTOR
=cut
=head2 new
$timer = IO::Async::Timer->new( %args )
Constructs a particular subclass of C<IO::Async::Timer> object, and returns
it. This constructor is provided for backward compatibility to older code
which doesn't use the subclasses. New code should directly construct a
subclass instead.
=over 8
=item mode => STRING
The type of timer to create. Currently the only allowed mode is C<countdown>
but more types may be added in the future.
=back
Once constructed, the C<Timer> 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 new
local/lib/perl5/IO/Async/Timer.pm view on Meta::CPAN
my $self = shift;
$self->stop;
}
=head1 METHODS
=cut
=head2 is_running
$running = $timer->is_running
Returns true if the Timer has been started, and has not yet expired, or been
stopped.
=cut
sub is_running
{
my $self = shift;
defined $self->{id};
}
=head2 start
$timer->start
Starts the Timer. Throws an error if it was already running.
If the Timer is not yet in a Loop, the actual start will be deferred until it
is added. Once added, it will be running, and will expire at the given
duration after the time it was added.
As a convenience, C<$timer> is returned. This may be useful for starting
timers at construction time:
$loop->add( IO::Async::Timer->new( ... )->start );
=cut
sub start
{
my $self = shift;
my $loop = $self->loop;
local/lib/perl5/IO/Async/Timer.pm view on Meta::CPAN
$self->{id} = $loop->watch_time(
$self->_make_enqueueargs,
code => $self->{cb},
);
return $self;
}
=head2 stop
$timer->stop
Stops the Timer if it is running. If it has not yet been added to the C<Loop>
but there is a start pending, this will cancel it.
=cut
sub stop
{
my $self = shift;
local/lib/perl5/IO/Async/Timer/Absolute.pm view on Meta::CPAN
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
local/lib/perl5/IO/Async/Timer/Absolute.pm view on Meta::CPAN
=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} ) {
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
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 )) {
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
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 is_expired
$expired = $timer->is_expired
Returns true if the Timer has already expired.
=cut
sub is_expired
{
my $self = shift;
return $self->{expired};
}
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
sub _make_enqueueargs
{
my $self = shift;
undef $self->{expired};
return after => $self->{delay};
}
=head2 reset
$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(
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
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
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
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
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
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";
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
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
( run in 0.785 second using v1.01-cache-2.11-cpan-49f99fa48dc )