view release on metacpan or  search on metacpan

local/lib/perl5/IO/Async/Internals/TimeQueue.pm  view on Meta::CPAN

package # hide from CPAN
  IO::Async::Internals::TimeQueue;

use strict;
use warnings;

use Carp;

use Time::HiRes qw( time );

BEGIN {
   my @methods = qw( next_time _enqueue cancel _fire );
   if( eval { require Heap::Fibonacci } ) {
      unshift our @ISA, "Heap::Fibonacci";
      require Heap::Elem;
      no strict 'refs';
      *$_ = \&{"HEAP_$_"} for @methods;
   }
   else {
      no strict 'refs';
      *$_ = \&{"ARRAY_$_"} for "new", @methods;
   }
}

# High-level methods

sub enqueue
{
   my $self = shift;
   my ( %params ) = @_;

   my $code = delete $params{code};
   ref $code or croak "Expected 'code' to be a reference";

   defined $params{time} or croak "Expected 'time'";
   my $time = $params{time};

   $self->_enqueue( $time, $code );
}

sub fire
{
   my $self = shift;
   my ( %params ) = @_;

   my $now = exists $params{now} ? $params{now} : time;
   $self->_fire( $now );
}

# Implementation using a Perl array

use constant {
   TIME => 0,
   CODE => 1,
};

sub ARRAY_new
{
   my $class = shift;
   return bless [], $class;
}

sub ARRAY_next_time
{
   my $self = shift;
   return @$self ? $self->[0]->[TIME] : undef;
}

sub ARRAY__enqueue
{
   my $self = shift;
   my ( $time, $code ) = @_;

   # TODO: This could be more efficient maybe using a binary search
   my $idx = 0;
   $idx++ while $idx < @$self and $self->[$idx][TIME] <= $time;
   splice @$self, $idx, 0, ( my $elem = [ $time, $code ]);

   return $elem;
}

sub ARRAY_cancel
{
   my $self = shift;
   my ( $id ) = @_;

   @$self = grep { $_ != $id } @$self;
}

sub ARRAY__fire
{
   my $self = shift;
   my ( $now ) = @_;

   my $count = 0;

   while( @$self ) {
      last if( $self->[0]->[TIME] > $now );

      my $top = shift @$self;

      $top->[CODE]->();
      $count++;
   }

   return $count;
}

# Implementation using Heap::Fibonacci

sub HEAP_next_time
{
   my $self = shift;

   my $top = $self->top;

   return defined $top ? $top->time : undef;
}

sub HEAP__enqueue