view release on metacpan or  search on metacpan

lib/Bot/Cobalt/Core/Role/Timers.pm  view on Meta::CPAN

);


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);