File Coverage

blib/lib/Time/DoAfter.pm

Criterion	Covered	Total	%
statement	76	81	93.8
branch	31	38	81.5
condition	13	24	54.1
subroutine	15	15	100.0
pod	8	8	100.0
total	143	166	86.1

package Time::DoAfter;
# ABSTRACT: Wait before doing by label contoller singleton

use strict;
use warnings;

use Carp 'croak';
use Time::HiRes qw( time sleep );

our $VERSION = '1.06'; # VERSION

sub _input_handler {
    my ( $input, $set ) = ( {}, {} );

    my $push_input = sub {
        $input->{ $set->{label} || '_label' } = {
            wait => $set->{wait},
            do   => $set->{do},
        };
        $set = {};
    };

    while (@_) {
        my $thing = shift;
        my $type  =
            ( ref $thing eq 'CODE' ) ? 'do' :
            ( ref $thing eq 'ARRAY' or not ref $thing and defined $thing and $thing =~ m/^[\d\.]+$/ ) ? 'wait' :
            ( not ref $thing and defined $thing and $thing !~ m/^[\d\.]+$/ ) ? 'label' : 'error';

        croak('Unable to understand input provided; at least one thing provided is not a proper input')
            if ( $type eq 'error' );

        $push_input->() if ( exists $set->{$type} );
        $set->{$type} = $thing;
    }

    $push_input->();
    return $input;
}

{
    my $singleton;

    sub new {
        if ($singleton) {
            my $input = _input_handler(@_);
            $singleton->{$_} = $input->{$_} for ( keys %$input );
            return $singleton;
        }

        shift;

        my $self = bless( _input_handler(@_), __PACKAGE__ );
        $singleton = $self;
        return $self;
    }
}

sub do {
    my $self       = shift;
    my $input      = _input_handler(@_);
    my $total_wait = 0;

    for my $label ( keys %$input ) {
        $input->{$label}{wait} //= $self->{$label}{wait} // 0;
        $input->{$label}{do} ||= $self->{$label}{do} || sub {};

        if ( $self->{$label}{last} ) {
            my $wait;
            if ( ref $self->{$label}{wait} ) {
                my $min = $self->{$label}{wait}[0] // 0;
                my $max = $self->{$label}{wait}[1] // 0;
                $wait = rand( $max - $min ) + $min;
            }
            else {
                $wait = $self->{$label}{wait};
            }

            my $sleep = $wait - ( time - $self->{$label}{last} );
            if ( $sleep > 0 ) {
                $total_wait += $sleep;
                sleep($sleep);
            }
        }

        $self->{$label}{last} = time;
        $self->{$label}{$_}   = $input->{$label}{$_} for ( qw( do wait ) );

        push( @{ $self->{history} }, {
            label => $label,
            do    => $self->{$label}{do},
            wait  => $self->{$label}{wait},
            time  => time,
        } );

        $self->{$label}{do}->();
    }

    return $total_wait;
}

sub now {
    return time;
}

sub last {
    my ( $self, $label, $time ) = @_;

    my $value_ref = ( defined $label ) ? \$self->{$label}{last} : \$self->history( undef, 1 )->[0]{time};
    $$value_ref = $time if ( defined $time );

    return $$value_ref;
}

sub history {
    my ( $self, $label, $last ) = @_;

    my $history = $self->{history} || [];
    $history = [ grep { $_->{label} eq $label } @$history ] if ($label);
    $history = [ grep { defined } @$history[ @$history - $last - 1, @$history - 1 ] ] if ( defined $last );

    return $history;
}

sub sub {
    my ( $self, $label, $sub ) = @_;

    my $value_ref = ( defined $label ) ? \$self->{$label}{do} : \$self->history( undef, 1 )->[0]{do};
    $$value_ref = $sub if ( ref $sub eq 'CODE' );

    return $$value_ref;
}

sub wait {
    my ( $self, $label, $wait ) = @_;

    my $value_ref = ( defined $label ) ? \$self->{$label}{wait} : \$self->history( undef, 1 )->[0]{wait};
    $$value_ref = $wait if ( defined $wait );

    return $$value_ref;
}

sub wait_adjust {
    my ( $self, $label, $wait_adjust ) = @_;

    my $value_ref = ( defined $label ) ? \$self->{$label}{wait} : \$self->history( undef, 1 )->[0]{wait};
    if ( ref $$value_ref eq 'ARRAY' ) {
        $_ += $wait_adjust for (@$$value_ref);
    }
    else {
        $$value_ref += $wait_adjust;
    }

    return $$value_ref;
}

1;

__END__