lib/App/Clifton/Tower/IRC.pm

   1 package App::Clifton::Tower::IRC;
   2
   3 use aliased 'Net::Async::IRC' => 'IRC_Client';
   4 use aliased 'App::Clifton::Chain';
   5 use Log::Contextual qw(:log);
   6 use Moo;
   7
   8 extends 'App::Clifton::Component';
   9
  10 has server => (is => 'ro', required => 1, weak_ref => 1);
  11 has irc_server => (is => 'ro', required => 1);
  12 has irc_nick => (is => 'ro', required => 1);
  13 has irc_client => (is => 'lazy');
  14 has chains => (is => 'ro', default => sub { {} });
  15
  16 sub _build_irc_client { shift->_new_child(IRC_Client, {}) }
  17
  18 sub BUILD {
  19   my ($self, $args) = @_;
  20   my $on_setup = $args->{on_setup};
  21   $self->irc_client->configure(
  22     on_message_text => $self->_replace_weakself('receive_irc_message'),
  23     on_message_ctcp_ACTION => $self->_replace_weakself('receive_irc_message')
  24   );
  25   $self->irc_client->login(
  26     nick => $self->irc_nick, host => $self->irc_server,
  27     on_login => $self->_capture_weakself(sub {
  28       my $self = shift;
  29       $self->server->irc_towers->{$self->irc_server}{$self->irc_nick}
  30         = $self;
  31       $on_setup->($self);
  32     }),
  33   );
  34 }
  35
  36 sub start_chain {
  37   my ($self, $args) = @_;
  38   $self->irc_client->send_message('JOIN', undef, $args->{irc_channel});
  39   my $new = $self->_new_child(Chain, {
  40     %$args, irc_tower => $self,
  41   });
  42   $self->chains->{$args->{irc_channel}} = $new;
  43   # I note here that actually we should make the Chain do
  44   # setup (JOIN) and confirm that first, but oh well
  45   $args->{on_finished}->({
  46     chain => $new,
  47     message => 'SUCCESS'
  48   });
  49 }
  50
  51 sub stop_chain {
  52   my ($self, $chain) = @_;
  53   $self->irc_client->send_message('PART', undef, $chain->irc_channel);
  54   delete $self->chains->{$chain->irc_channel};
  55   $self->remove_child($chain);
  56 }
  57
  58 sub send_irc_message {
  59   my ($self, $args) = @_;
  60   $self->irc_client->send_message('PRIVMSG', undef, @{$args}{qw(to text)});
  61 }
  62
  63 sub receive_irc_message {
  64   my ($self, $message, $hints) = @_;
  65   return if $hints->{prefix_is_me};
  66   if (my $chain = $self->chains->{$hints->{target_name}||''}) {
  67     $chain->handle_irc_message($message, $hints);
  68   } elsif ($chain = $self->chains->{$hints->{targets}||''}) {
  69     $chain->handle_irc_message($message, $hints);
  70   }
  71 }
  72
  73 1;