File Coverage

blib/lib/RxPerl/SyncTimers.pm

Criterion	Covered	Total	%
statement	67	67	100.0
branch	9	12	75.0
condition	3	3	100.0
subroutine	16	16	100.0
pod	0	2	0.0
total	95	100	95.0

package RxPerl::SyncTimers;

use strict;
use warnings;

use parent 'RxPerl::Base';

use RxPerl ':all';

use Sub::Util 'set_subname';
use Module::Load 'load';

use Exporter 'import';
our @EXPORT_OK = (@RxPerl::EXPORT_OK);
our %EXPORT_TAGS = (%RxPerl::EXPORT_TAGS);

our $VERSION = "v6.29.8";

my $mojo_loaded = eval {
    load 'Mojo::IOLoop';
    1;
};

foreach my $func_name (@EXPORT_OK) {
    set_subname __PACKAGE__."::$func_name", \&{$func_name};
}

our $promise_class;
our $DEBUG = 0;

my $_id_cursor = 0;
my %_timed_events;
my %_timeline;

our $time = 0;

sub reset {
    my ($class) = @_;

    $_id_cursor = 0;
    undef %_timed_events;
    undef %_timeline;
    $time = 0;
}

sub start {
    my ($class) = @_;

    while (%_timeline) {
        my @times = sort {$a <=> $b} keys %_timeline;
        $time = $times[0];
        print "** Time jump to: $time **\n" if $DEBUG;
        while (my $item = shift @{ $_timeline{$time} }) {
            delete $_timed_events{$item->{id}};
            $item->{sub}->();
            Mojo::IOLoop->start if $mojo_loaded;
        }
        delete $_timeline{$time};
    }
}

sub _round_number { 0 + sprintf("%.1f", $_[0]) }

sub _timer {
    my ($after, $sub, %opts) = @_;

    # opts can be: id

    my $id = $opts{id} // $_id_cursor++;
    my $target_time = _round_number($time + $after);
    $_timed_events{$id} = {
        time => $target_time,
        sub => $sub,
    };
    push @{ $_timeline{$target_time} }, {
        id => $id,
        sub => $sub,
    };

    return $id;
}

sub _cancel_timer {
    my ($id) = @_;

    return if !defined $id;

    my $event = delete $_timed_events{$id} or return;

    exists $_timeline{$event->{time}} or return;

    @{ $_timeline{$event->{time}} } = grep {$_->{id} ne $id} @{ $_timeline{$event->{time}} };

    if (! @{ $_timeline{$event->{time}} }) {
        delete $_timeline{$event->{time}};
    }
}

sub _add_recursive_timer {
    my ($after, $sub, $id) = @_;

    _timer($after, sub {
        _add_recursive_timer($after, $sub, $id);
        $sub->();
    }, id => $id);
}

sub _interval {
    my ($after, $sub) = @_;

    my $id = $_id_cursor++;

    _add_recursive_timer($after, $sub, $id);

    return $id;
}

sub _cancel_interval {
    my ($id) = @_;

    _cancel_timer($id);
}

1;