File Coverage

blib/lib/Bot/Cobalt/IRC/FloodChk.pm
Criterion Covered Total %
statement 34 47 72.3
branch 8 16 50.0
condition 3 8 37.5
subroutine 8 9 88.8
pod 3 3 100.0
total 56 83 67.4


line stmt bran cond sub pod time code
1             package Bot::Cobalt::IRC::FloodChk;
2             $Bot::Cobalt::IRC::FloodChk::VERSION = '0.021002';
3 6     6   14372 use Carp;
  6         6  
  6         317  
4 6     6   379 use strictures 2;
  6         1183  
  6         181  
5              
6 6     6   1085 use Bot::Cobalt::Common ':types';
  6         7  
  6         26  
7              
8 6     6   27 use List::Objects::WithUtils;
  6         7  
  6         34  
9 6     6   6405 use Time::HiRes ();
  6         1892  
  6         90  
10              
11 6     6   865 use Moo;
  6         12034  
  6         33  
12              
13             ## _fqueue->{$context}->{$key} = array()
14             ## FIXME Should probably be an obj ...
15             has _fqueue => (
16             is => 'rw',
17             lazy => 1,
18             default => sub { +{} },
19             );
20              
21             has count => ( is => 'rw', isa => Num, required => 1 );
22             has in => ( is => 'rw', isa => Num, required => 1 );
23              
24             sub check {
25 8     8 1 2446 my ($self, $context, $key) = @_;
26 8 50 33     40 return unless defined $context and defined $key;
27            
28 8   66     139 my $thisq = $self->_fqueue->{$context}->{$key} //= array;
29            
30 8 100       89 if ((my $pending = $thisq->count) >= $self->count) {
31              
32 2         41 my $oldest_ts = $thisq->head;
33 2         29 my $ev_c = $self->count;
34 2         24 my $ev_sec = $self->in;
35              
36 2         458 my $delayed =
37             ($oldest_ts + ($pending * $ev_sec / $ev_c) )
38             - Time::HiRes::time();
39            
40             ## Too many events in this time window:
41 2 50       11 return $delayed if $delayed > 0;
42              
43             ## ...otherwise shift and continue:
44 0         0 $thisq->shift;
45             }
46              
47             ## Safe to push this ev, no delay:
48 6         627 $thisq->push( Time::HiRes::time() );
49 6         40 return 0
50             }
51              
52             sub clear {
53 2     2 1 4 my ($self, $context, $key) = @_;
54 2 50       5 confess "clear() needs a context specified"
55             unless defined $context;
56            
57 2 50       39 return unless exists $self->_fqueue->{$context};
58            
59 2 100       29 return delete $self->_fqueue->{$context}->{$key}
60             if defined $key;
61            
62 1         14 delete $self->_fqueue->{$context}
63             }
64              
65             sub expire {
66             ## Clear keys when recent_event_time - time > $self->in
67 0     0 1   my ($self) = @_;
68              
69 0           CONTEXT: for my $context (keys %{ $self->_fqueue } ) {
  0            
70              
71 0           KEY: for my $key (keys %{ $self->_fqueue->{$context} } ) {
  0            
72              
73 0           my $events = $self->_fqueue->{$context}->{$key};
74 0   0       my $latest_time = $events->get(-1) // next KEY;
75            
76 0 0         if (Time::HiRes::time() - $latest_time > $self->in) {
77             ## It's been more than ->in seconds since latest event was
78             ## noted. We can clear() this entry.
79 0           $self->clear($context, $key);
80             }
81             } # KEY
82            
83 0 0         unless (keys %{ $self->_fqueue->{$context} }) {
  0            
84             ## Nothing left for this context.
85 0           $self->clear($context);
86             }
87             }
88             }
89              
90             1;
91             __END__