| File: | lib/Time/DoAfter.pm |
| Coverage: | 86.2% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Time::DoAfter; | ||||||
| 2 | # ABSTRACT: Wait before doing by label contoller singleton | ||||||
| 3 | |||||||
| 4 | 1 1 1 | 3 4 24 | use strict; | ||||
| 5 | 1 1 1 | 3 1 25 | use warnings; | ||||
| 6 | |||||||
| 7 | 1 1 1 | 3 1 53 | use Carp 'croak'; | ||||
| 8 | 1 1 1 | 3 1 85 | use Time::HiRes qw( time sleep ); | ||||
| 9 | |||||||
| 10 | # VERSION | ||||||
| 11 | |||||||
| 12 | sub _input_handler { | ||||||
| 13 | 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 | 43 | }; | ||||
| 20 | 13 | 10 | $set = {}; | ||||
| 21 | 9 | 20 | }; | ||||
| 22 | |||||||
| 23 | 9 | 13 | while (@_) { | ||||
| 24 | 19 | 16 | my $thing = shift; | ||||
| 25 | 19 | 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 | 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 | 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 | 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 | |||||||
| 59 | sub do { | ||||||
| 60 | 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 | 24 | $input->{$label}{wait} //= $self->{$label}{wait} // 0; | ||||
| 66 | 5 | 17 | $input->{$label}{do} ||= $self->{$label}{do} || sub {}; | ||||
| 67 | |||||||
| 68 | 5 | 7 | if ( $self->{$label}{last} ) { | ||||
| 69 | 3 | 4 | my $wait; | ||||
| 70 | 3 | 4 | if ( ref $self->{$label}{wait} ) { | ||||
| 71 | 0 | 0 | my $min = $self->{$label}{wait}[0] // 0; | ||||
| 72 | 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 | 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 | |||||||
| 102 | sub now { | ||||||
| 103 | 1 | 1 | 5 | return time; | |||
| 104 | } | ||||||
| 105 | |||||||
| 106 | sub last { | ||||||
| 107 | 4 | 1 | 4 | my ( $self, $label, $time ) = @_; | |||
| 108 | |||||||
| 109 | 4 | 26 | my $value_ref = ( defined $label ) ? \$self->{$label}{last} : \$self->history( undef, 1 )->[0]{time}; | ||||
| 110 | 4 | 8 | $$value_ref = $time if ( defined $time ); | ||||
| 111 | |||||||
| 112 | 4 | 13 | return $$value_ref; | ||||
| 113 | } | ||||||
| 114 | |||||||
| 115 | sub history { | ||||||
| 116 | 4 | 1 | 7 | my ( $self, $label, $last ) = @_; | |||
| 117 | |||||||
| 118 | 4 | 5 | my $history = $self->{history}; | ||||
| 119 | 4 10 | 9 16 | $history = [ grep { $_->{label} eq $label } @$history ] if ($label); | ||||
| 120 | 4 4 | 11 6 | $history = [ grep { defined } @$history[ @$history - $last - 1, @$history - 1 ] ] if ( defined $last ); | ||||
| 121 | |||||||
| 122 | 4 | 14 | return $history; | ||||
| 123 | } | ||||||
| 124 | |||||||
| 125 | sub sub { | ||||||
| 126 | 3 | 1 | 5 | my ( $self, $label, $sub ) = @_; | |||
| 127 | |||||||
| 128 | 3 | 6 | my $value_ref = ( defined $label ) ? \$self->{$label}{do} : \$self->history( undef, 1 )->[0]{do}; | ||||
| 129 | 3 | 8 | $$value_ref = $sub if ( ref $sub eq 'CODE' ); | ||||
| 130 | |||||||
| 131 | 3 | 8 | return $$value_ref; | ||||
| 132 | } | ||||||
| 133 | |||||||
| 134 | sub wait { | ||||||
| 135 | 3 | 1 | 5 | my ( $self, $label, $wait ) = @_; | |||
| 136 | |||||||
| 137 | 3 | 9 | my $value_ref = ( defined $label ) ? \$self->{$label}{wait} : \$self->history( undef, 1 )->[0]{wait}; | ||||
| 138 | 3 | 7 | $$value_ref = $wait if ( defined $wait ); | ||||
| 139 | |||||||
| 140 | 3 | 13 | return $$value_ref; | ||||
| 141 | } | ||||||
| 142 | |||||||
| 143 | 1; | ||||||