File Coverage

File:lib/Time/DoAfter.pm
Coverage:83.5%

linestmtbrancondsubpodtimecode
1package Time::DoAfter;
2# ABSTRACT: Wait before doing by label contoller singleton
3
4
1
1
1
1
3
3
20
use strict;
5
1
1
1
1
3
1
23
use warnings;
6
7
1
1
1
1
3
1
39
use Carp 'croak';
8
1
1
1
1
3
1
5
use Time::HiRes qw( time sleep );
9
10# VERSION
11
12sub _input_handler {
13
6
6
8
    my ( $input, $set ) = ( {}, {} );
14
15    my $push_input = sub {
16        $input->{ $set->{label} || '_label' } = {
17            wait => $set->{wait},
18            do   => $set->{do},
19
6
100
6
30
        };
20
6
6
        $set = {};
21
6
16
    };
22
23
6
11
    while (@_) {
24
4
4
        my $thing = shift;
25
4
50
50
100
33
33
53
        my $type  =
26            ( ref $thing eq 'CODE' ) ? 'do' :
27            ( ref $thing eq 'ARRAY' or not ref $thing and defined $thing and $thing =~ m/^[\d\.]+$/ ) ? 'wait' :
28            ( not ref $thing and defined $thing and $thing !~ m/^[\d\.]+$/ ) ? 'label' : 'error';
29
30
4
50
8
        croak('Unable to understand input provided; at least one thing provided is not a proper input')
31            if ( $type eq 'error' );
32
33
4
50
6
        $push_input->() if ( exists $set->{$type} );
34
4
10
        $set->{$type} = $thing;
35    }
36
37
6
7
    $push_input->();
38
6
18
    return $input;
39}
40
41{
42    my $singleton;
43
44    sub new {
45
4
100
4
1
18
        return $singleton if ($singleton);
46
1
1
        shift;
47
48
1
3
        my $self = bless( _input_handler(@_), __PACKAGE__ );
49
1
1
        $singleton = $self;
50
1
5
        return $self;
51    }
52}
53
54sub do {
55
5
5
1
6
    my $self = shift;
56
5
7
    my $input = _input_handler(@_);
57
58
5
13
    for my $label ( keys %$input ) {
59
5
33
23
        $input->{$label}{wait} //= $self->{$label}{wait} // 0;
60
5
67
4
24
        $input->{$label}{do} ||= $self->{$label}{do} || sub {};
61
62
5
100
9
        if ( $self->{$label}{last} ) {
63
3
3
            my $wait;
64
3
50
5
            if ( ref $self->{$label}{wait} ) {
65
0
0
0
                my $min = $self->{$label}{wait}[0] // 0;
66
0
0
0
                my $max = $self->{$label}{wait}[1] // 0;
67
0
0
                $wait = rand( $max - $min ) + $min;
68            }
69            else {
70
3
3
                $wait = $self->{$label}{wait};
71            }
72
73
3
10
            my $sleep = $wait - ( time - $self->{$label}{last} );
74
3
50
7
            sleep($sleep) if ( $sleep > 0 );
75        }
76
77
5
42
        $self->{$label}{last} = time;
78
5
13
        $self->{$label}{$_}   = $input->{$label}{$_} for ( qw( do wait ) );
79
80
5
20
        push( @{ $self->{history} }, {
81            label => $label,
82            do    => $self->{$label}{do},
83            wait  => $self->{$label}{wait},
84
5
4
            time  => time,
85        } );
86
87
5
7
        $self->{$label}{do}->();
88    }
89}
90
91sub now {
92
1
1
1
4
    return time;
93}
94
95sub last {
96
2
2
1
4
    my ( $self, $label ) = @_;
97
2
100
7
    return ( defined $label ) ? $self->{$label}{last} : $self->history( undef, 1 )->[0]{time};
98}
99
100sub history {
101
4
4
1
5
    my ( $self, $label, $last ) = @_;
102
103
4
5
    my $history = $self->{history};
104
4
10
100
9
14
    $history = [ grep { $_->{label} eq $label } @$history ] if ($label);
105
4
4
100
9
6
    $history = [ grep { defined } @$history[ @$history - $last - 1, @$history - 1 ] ] if ( defined $last );
106
107
4
15
    return $history;
108}
109
1101;