File Coverage

blib/lib/Bot/Backbone/SendPolicy/MinimumInterval.pm
Criterion Covered Total %
statement 26 26 100.0
branch 11 12 91.6
condition 6 9 66.6
subroutine 5 5 100.0
pod 1 1 100.0
total 49 53 92.4


line stmt bran cond sub pod time code
1             package Bot::Backbone::SendPolicy::MinimumInterval;
2             $Bot::Backbone::SendPolicy::MinimumInterval::VERSION = '0.160630';
3 1     1   546 use v5.10;
  1         3  
4 1     1   4 use Moose;
  1         1  
  1         7  
5              
6             with 'Bot::Backbone::SendPolicy';
7              
8 1     1   5362 use AnyEvent;
  1         3626  
  1         212  
9              
10             # ABSTRACT: Prevent any message from being delivered too soon
11              
12              
13             has interval => (
14                 is => 'ro',
15                 isa => 'Num',
16                 required => 1,
17             );
18              
19              
20             has queue_length => (
21                 is => 'ro',
22                 isa => 'Int',
23                 predicate => 'has_queue',
24             );
25              
26              
27             has discard => (
28                 is => 'ro',
29                 isa => 'Bool',
30                 required => 1,
31                 default => 0,
32             );
33              
34              
35             has last_send_time => (
36                 is => 'rw',
37                 isa => 'Num',
38                 predicate => 'has_last_send_time',
39             );
40              
41              
42             sub _too_soon {
43 598     598   559     my $self = shift;
44 598         8744     my $now = AnyEvent->now;
45              
46 598 100       21093     return 0
47                     unless $self->has_last_send_time;
48              
49 596 100 100     17275     return $self->last_send_time + $self->interval
50                     if ($self->last_send_time > $now)
51                     or ($now - $self->last_send_time < $self->interval);
52              
53 3         5     return 0;
54             }
55              
56             sub allow_send {
57 598     598 1 531     my ($self, $options) = @_;
58              
59 598         1240     my %send = ( allow => 1 );
60 598         9941     my $now = AnyEvent->now;
61 598         4560     my $too_soon = $self->_too_soon;
62              
63 598         696     my $save = 1;
64 598 100       1038     if ($too_soon) {
65              
66             # Messages coming too fast should be thrown away
67 593 100       16175         if ($self->discard) {
68 295         389             $save = 0;
69 295         356             $send{allow} = 0;
70                     }
71              
72             # Messages coming too fast should be postponed
73                     else {
74 298         650             $send{after} = $too_soon - $now;
75              
76             # If the number of messages queued is too long, nevermind...
77                         $send{allow} = 0
78                             if $self->has_queue
79 298 50 33     9541                and $send{after} / $self->interval > $self->queue_length;
80                     }
81                 }
82              
83 598 100 66     9735     $self->last_send_time($too_soon || $now) if $save;
84 598         1437     return \%send;
85             }
86              
87             __PACKAGE__->meta->make_immutable;
88              
89             __END__
90            
91             =pod
92            
93             =encoding UTF-8
94            
95             =head1 NAME
96            
97             Bot::Backbone::SendPolicy::MinimumInterval - Prevent any message from being delivered too soon
98            
99             =head1 VERSION
100            
101             version 0.160630
102            
103             =head1 SYNOPSIS
104            
105             send_policy no_flooding => (
106             MinimumInterval => {
107             interval => 1.5,
108             discard => 1,
109             queue_length => 5,
110             },
111             );
112            
113             =head1 DESCRIPTION
114            
115             This send policy will prevent any message from being sent more frequently than the permitted L</interval>. Messages sent more frequently than this will either be delayed to match the interval or discarded.
116            
117             =head1 ATTRIBUTES
118            
119             =head2 interval
120            
121             This is the fractional number of seconds that must pass between each message sent. This attribute is required. The number must be positive (obviously).
122            
123             =head2 queue_length
124            
125             This is the number of items that will be queued up before additional items will be discarded.
126            
127             For example, if L</interval> were set to 1 second and C<queue_length> to 10 and a burst of 100 items happened within 1 second, only the first 10 would be sent, 1 per second. The other 90 items would be discarded. There's a slight fudge factor here due to times, so you might see a few more actually sent depending on how much delay happens in handling events.
128            
129             If L</discard> is set to false, it is recommended that you set this value to something reasonable.
130            
131             =head2 discard
132            
133             If set to true, any message sent more frequently than the L</interval> will be immediately discarded. This is false by default.
134            
135             =head1 last_send_time
136            
137             This will be set each time the policy encounters a message. If L</discard> is false, this value may move into the future to signify the time at which the last queued message will be sent.
138            
139             =head1 METHODS
140            
141             =head2 allow_send
142            
143             Applies the configured policy to the given message.
144            
145             =head1 AUTHOR
146            
147             Andrew Sterling Hanenkamp <hanenkamp@cpan.org>
148            
149             =head1 COPYRIGHT AND LICENSE
150            
151             This software is copyright (c) 2016 by Qubling Software LLC.
152            
153             This is free software; you can redistribute it and/or modify it under
154             the same terms as the Perl 5 programming language system itself.
155            
156             =cut
157