File Coverage

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

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