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

package Bot::Cobalt::IRC::FloodChk;
$Bot::Cobalt::IRC::FloodChk::VERSION = '0.021003';
use Carp;
use strictures 2;

use Bot::Cobalt::Common ':types';

use List::Objects::WithUtils;
use Time::HiRes ();

use Moo;

## _fqueue->{$context}->{$key} = array()
## FIXME Should probably be an obj ...
has _fqueue => (
  is      => 'rw',
  lazy    => 1,
  default => sub { +{} },
);

has count => ( is => 'rw', isa => Num, required => 1 );
has in    => ( is => 'rw', isa => Num, required => 1 );

sub check {
  my ($self, $context, $key) = @_;
  return unless defined $context and defined $key;

  my $thisq = $self->_fqueue->{$context}->{$key} //= array;

  if ((my $pending = $thisq->count) >= $self->count) {

    my $oldest_ts = $thisq->head;
    my $ev_c      = $self->count;
    my $ev_sec    = $self->in;

    my $delayed =
      ($oldest_ts + ($pending * $ev_sec / $ev_c) )
      - Time::HiRes::time();

    ## Too many events in this time window:
    return $delayed if $delayed > 0;

    ## ...otherwise shift and continue:
    $thisq->shift;
  }

  ## Safe to push this ev, no delay:
  $thisq->push( Time::HiRes::time() );
  return 0
}

sub clear {
  my ($self, $context, $key) = @_;
  confess "clear() needs a context specified"
    unless defined $context;

  return unless exists $self->_fqueue->{$context};

  return delete $self->_fqueue->{$context}->{$key}
    if defined $key;

  delete $self->_fqueue->{$context}
}

sub expire {
  ## Clear keys when recent_event_time - time > $self->in
  my ($self) = @_;

  CONTEXT: for my $context (keys %{ $self->_fqueue } ) {

    KEY: for my $key (keys %{ $self->_fqueue->{$context} } ) {

      my $events = $self->_fqueue->{$context}->{$key};
      my $latest_time = $events->get(-1) // next KEY;

      if (Time::HiRes::time() - $latest_time > $self->in) {
        ## It's been more than ->in seconds since latest event was
        ## noted. We can clear() this entry.
        $self->clear($context, $key);
      }
    } # KEY

    unless (keys %{ $self->_fqueue->{$context} }) {
      ## Nothing left for this context.
      $self->clear($context);
    }
  }
}

1;
__END__