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.161950';
3 1     1   672 use v5.10;
  1         3  
4 1     1   5 use Moose;
  1         1  
  1         7  
5              
6             with 'Bot::Backbone::SendPolicy';
7              
8 1     1   5938 use AnyEvent;
  1         3799  
  1         264  
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   967 my $self = shift;
44 598         11568 my $now = AnyEvent->now;
45              
46 598 100       27792 return 0
47             unless $self->has_last_send_time;
48              
49 596 100 100     22914 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         6 return 0;
54             }
55              
56             sub allow_send {
57 598     598 1 763 my ($self, $options) = @_;
58              
59 598         1726 my %send = ( allow => 1 );
60 598         14460 my $now = AnyEvent->now;
61 598         6277 my $too_soon = $self->_too_soon;
62              
63 598         1248 my $save = 1;
64 598 100       1897 if ($too_soon) {
65              
66             # Messages coming too fast should be thrown away
67 593 100       21273 if ($self->discard) {
68 295         455 $save = 0;
69 295         669 $send{allow} = 0;
70             }
71              
72             # Messages coming too fast should be postponed
73             else {
74 298         988 $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     12205 and $send{after} / $self->interval > $self->queue_length;
80             }
81             }
82              
83 598 100 66     12895 $self->last_send_time($too_soon || $now) if $save;
84 598         1883 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.161950
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