File Coverage

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

linestmtbrancondsubpodtimecode
1package Time::DoAfter;
2# ABSTRACT: Wait before doing by label contoller singleton
3
4
1
1
1
1
3
4
24
use strict;
5
1
1
1
1
3
1
25
use warnings;
6
7
1
1
1
1
3
1
53
use Carp 'croak';
8
1
1
1
1
3
1
85
use Time::HiRes qw( time sleep );
9
10# VERSION
11
12sub _input_handler {
13
9
9
11
    my ( $input, $set ) = ( {}, {} );
14
15    my $push_input = sub {
16        $input->{ $set->{label} || '_label' } = {
17            wait => $set->{wait},
18            do   => $set->{do},
19
13
100
13
43
        };
20
13
10
        $set = {};
21
9
20
    };
22
23
9
13
    while (@_) {
24
19
16
        my $thing = shift;
25
19
50
100
100
33
67
143
        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
19
50
23
        croak('Unable to understand input provided; at least one thing provided is not a proper input')
31            if ( $type eq 'error' );
32
33
19
100
83
        $push_input->() if ( exists $set->{$type} );
34
19
41
        $set->{$type} = $thing;
35    }
36
37
9
10
    $push_input->();
38
9
28
    return $input;
39}
40
41{
42    my $singleton;
43
44    sub new {
45
4
100
4
1
13
        if ($singleton) {
46
3
5
            my $input = _input_handler(@_);
47
3
11
            $singleton->{$_} = $input->{$_} for ( keys %$input );
48
3
12
            return $singleton;
49        }
50
51
1
1
        shift;
52
53
1
3
        my $self = bless( _input_handler(@_), __PACKAGE__ );
54
1
1
        $singleton = $self;
55
1
5
        return $self;
56    }
57}
58
59sub do {
60
5
5
1
6
    my $self       = shift;
61
5
6
    my $input      = _input_handler(@_);
62
5
3
    my $total_wait = 0;
63
64
5
9
    for my $label ( keys %$input ) {
65
5
33
24
        $input->{$label}{wait} //= $self->{$label}{wait} // 0;
66
5
67
1
17
        $input->{$label}{do} ||= $self->{$label}{do} || sub {};
67
68
5
100
7
        if ( $self->{$label}{last} ) {
69
3
4
            my $wait;
70
3
50
4
            if ( ref $self->{$label}{wait} ) {
71
0
0
0
                my $min = $self->{$label}{wait}[0] // 0;
72
0
0
0
                my $max = $self->{$label}{wait}[1] // 0;
73
0
0
                $wait = rand( $max - $min ) + $min;
74            }
75            else {
76
3
3
                $wait = $self->{$label}{wait};
77            }
78
79
3
6
            my $sleep = $wait - ( time - $self->{$label}{last} );
80
3
50
7
            if ( $sleep > 0 ) {
81
0
0
                $total_wait += $sleep;
82
0
0
                sleep($sleep);
83            }
84        }
85
86
5
53
        $self->{$label}{last} = time;
87
5
26
        $self->{$label}{$_}   = $input->{$label}{$_} for ( qw( do wait ) );
88
89
5
19
        push( @{ $self->{history} }, {
90            label => $label,
91            do    => $self->{$label}{do},
92            wait  => $self->{$label}{wait},
93
5
4
            time  => time,
94        } );
95
96
5
7
        $self->{$label}{do}->();
97    }
98
99
5
18
    return $total_wait;
100}
101
102sub now {
103
1
1
1
5
    return time;
104}
105
106sub last {
107
4
4
1
4
    my ( $self, $label, $time ) = @_;
108
109
4
100
26
    my $value_ref = ( defined $label ) ? \$self->{$label}{last} : \$self->history( undef, 1 )->[0]{time};
110
4
100
8
    $$value_ref = $time if ( defined $time );
111
112
4
13
    return $$value_ref;
113}
114
115sub history {
116
4
4
1
7
    my ( $self, $label, $last ) = @_;
117
118
4
5
    my $history = $self->{history};
119
4
10
100
9
16
    $history = [ grep { $_->{label} eq $label } @$history ] if ($label);
120
4
4
100
11
6
    $history = [ grep { defined } @$history[ @$history - $last - 1, @$history - 1 ] ] if ( defined $last );
121
122
4
14
    return $history;
123}
124
125sub sub {
126
3
3
1
5
    my ( $self, $label, $sub ) = @_;
127
128
3
50
6
    my $value_ref = ( defined $label ) ? \$self->{$label}{do} : \$self->history( undef, 1 )->[0]{do};
129
3
100
8
    $$value_ref = $sub if ( ref $sub eq 'CODE' );
130
131
3
8
    return $$value_ref;
132}
133
134sub wait {
135
3
3
1
5
    my ( $self, $label, $wait ) = @_;
136
137
3
50
9
    my $value_ref = ( defined $label ) ? \$self->{$label}{wait} : \$self->history( undef, 1 )->[0]{wait};
138
3
100
7
    $$value_ref = $wait if ( defined $wait );
139
140
3
13
    return $$value_ref;
141}
142
1431;