File Coverage

blib/lib/Bot/Cobalt/Core/Role/Timers.pm

Criterion	Covered	Total	%
statement	18	103	17.4
branch	0	48	0.0
condition	0	16	0.0
subroutine	7	16	43.7
pod	7	7	100.0
total	32	190	16.8

package Bot::Cobalt::Core::Role::Timers;
$Bot::Cobalt::Core::Role::Timers::VERSION = '0.021002';
use 5.10.1;
use strictures 2;

use Bot::Cobalt::Timer;

use Scalar::Util qw/blessed/;

use List::Objects::WithUtils;

use Moo::Role;

requires qw/
  log
  debug
  send_event
/;


## FIXME tests are nonexistant

has TimerPool => (
  is        => 'rw',
  builder   => sub { hash },
);


sub timer_gen_unique_id {
  my ($self) = @_;
  my @p = ( 'a'..'f', 1..9 );
  my $id = join '', map { $p[rand@p] } 1 .. 4;
  $id .= $p[rand@p] while $self->TimerPool->exists($id);
  $id
}

sub timer_set {
  my ($self, $item) = @_;

  my ($caller_pkg, $caller_line) = (caller)[0,2];
  my $d_line = "$caller_pkg line $caller_line";

  my $timer = $item;
  unless (blessed $item && $item->isa('Bot::Cobalt::Timer') ) {
    ## hashref-style (we hope)
    $timer = $self->timer_set_hashref( $item, @_[2 .. $#_] );
  }

  unless ($timer->has_id) {
    $timer->id( $self->timer_gen_unique_id );
  }

  ## Add to our TimerPool.
  $self->TimerPool->set($timer->id => $timer);
  $self->send_event( new_timer => $timer->id );

  $self->log->debug(
    "timer_set; ".join ' ', $timer->id, $timer->delay, $timer->event
  ) if $self->debug > 1;

  $timer->id
}

sub timer_set_hashref {
  my ($self, $delay, $ev, $id) = @_;

  my ($caller_pkg, $caller_line) = (caller)[0,2];
  my $d_line = "$caller_pkg line $caller_line";

  unless (ref $ev eq 'HASH') {
    if (ref $ev) {
      $self->log->warn(
        "timer_set_hashref expected HASH but got $ev; $d_line"
      );
      return
    } else {
      ## Assume we were passed a simple string.
      $ev = { Event => $ev };
    }
  }

  my $timer = Bot::Cobalt::Timer->new;

  $timer->id($id) if $id;

  ## Try to guess type, or default to 'event'
  my $type = $ev->{Type};
  unless ($type) {
    if (defined $ev->{Text} && defined $ev->{Context}) {
      $type = 'msg'
    } else {
      $type = 'event'
    }
  }

  my($event_name, @event_args);

  TYPE: {
    if ($type eq "event") {
      unless (defined $ev->{Event}) {
        $self->log->warn(
          "timer_set_hashref no Event specified; $d_line"
        );
        return
      }

      $timer->event( $ev->{Event} );
      $timer->args( $ev->{Args}//[] );

      last TYPE
    }

    if (grep { $type eq $_ } qw/msg message privmsg action/) {
      unless (defined $ev->{Text} && defined $ev->{Target}) {
        $self->log->warn(
          "timer_set_hashref; $type needs Text and Target; $d_line"
        );

        return
      }

      $timer->context( $ev->{Context} ) if defined $ev->{Context};
      $timer->target( $ev->{Target} );
      $timer->text( $ev->{Text} );
      $timer->type( $type );

      last TYPE
    }

    $self->log->error("Unknown type $type passed to timer_set_hashref");
    return
  }

  ## Tag w/ __PACKAGE__ if no alias is specified
  $timer->alias( $ev->{Alias} // scalar caller );

  ## Start ticking.
  $timer->delay( $delay );

  $timer
}

sub timer_get {
  my ($self, $id) = @_;
  return unless $id and $self->TimerPool->exists($id);

  $self->log->debug("timer retrieved; $id")
    if $self->debug > 1;

  $self->TimerPool->get($id)
}

sub timer_get_alias {
  ## get all timerIDs for this alias
  my ($self, $alias) = @_;
  return unless $alias;

  my @timers;
  $self->TimerPool->kv->visit(sub {
    my ($id, $entry) = @$_;
    push @timers, $id if $entry->alias eq $alias
  });

  wantarray ? @timers : \@timers
}

sub timer_del {
  ## delete a timer by its ID
  ## doesn't care if the timerID actually exists or not.
  my ($self, $id) = @_;
  return unless $id;

  $self->log->debug("timer del; $id")
    if $self->debug > 1;

  return unless $self->TimerPool->exists($id);

  my $deleted = $self->TimerPool->delete($id);
  $self->send_event( 'deleted_timer', $id, $deleted->all );

  $deleted->all
}

sub timer_del_alias {
  my ($self, $alias) = @_;
  return unless $alias;

  my @deleted;
  $self->TimerPool->kv->visit(sub {
    my ($id, $entry) = @$_;
    if ($entry->alias eq $alias) {
      push @deleted, $id;
      my $removed = $self->TimerPool->delete($id);
      $self->send_event( deleted_timer => $id, $removed );
    }
  });

  wantarray ? @deleted : scalar @deleted
}


1;
__END__