view release on metacpan or  search on metacpan

lib/App/Alice/IRC.pm  view on Meta::CPAN

package App::Alice::IRC;

use AnyEvent;
use AnyEvent::IRC::Client;
use List::Util qw/min first/;
use List::MoreUtils qw/uniq/;
use Digest::MD5 qw/md5_hex/;
use Any::Moose;
use utf8;
use Encode;

has 'cl' => (
  is      => 'rw',
  default => sub {AnyEvent::IRC::Client->new},
);

has 'alias' => (
  isa      => 'Str',
  is       => 'ro',
  required => 1,
);

has 'nick_cached' => (
  isa      => 'Str',
  is       => 'rw',
  lazy     => 1,
  default  => sub {
    my $self = shift;
    return $self->config->{nick};
  },
);

sub config {
  $_[0]->app->config->servers->{$_[0]->alias};
}

has 'app' => (
  isa      => 'App::Alice',
  is       => 'ro',
  weak_ref => 1,
  required => 1,
);

has 'reconnect_timer' => (
  is => 'rw'
);

has [qw/reconnect_count connect_time/] => (
  is  => 'rw',
  isa => 'Int',
  default   => 0,
);

sub increase_reconnect_count {$_[0]->reconnect_count($_[0]->reconnect_count + 1)}
sub reset_reconnect_count {$_[0]->reconnect_count(0)}

has [qw/is_connected disabled removed/] => (
  is  => 'rw',
  isa => 'Bool',
  default => 0,
);

has _nicks => (
  is        => 'rw',
  isa       => 'ArrayRef[HashRef|Undef]',
  default   => sub {[]},
);

sub nicks {@{$_[0]->_nicks}}
sub all_nicks {[map {$_->{nick}} @{$_[0]->_nicks}]}
sub add_nick {push @{$_[0]->_nicks}, $_[1]}
sub remove_nick {$_[0]->_nicks([grep {$_->{nick} ne $_[1]} $_[0]->nicks])}
sub get_nick_info {first {$_->{nick} eq $_[1]} $_[0]->nicks}
sub includes_nick {$_[0]->get_nick_info($_[1])}
sub all_nick_info {$_[0]->nicks}
sub set_nick_info {$_[0]->remove_nick($_[1]); $_[0]->add_nick($_[2]);}
sub clear_nicks {$_[0]->_nicks([])}

has whois_cbs => (
  is        => 'rw',
  isa       => 'HashRef[CodeRef]',
  default   => sub {{}},
);

sub add_whois_cb {
  my ($self, $nick, $cb) = @_;
  $self->whois_cbs->{$nick} = $cb;
  $self->send_srv(WHO => $nick);
}

sub BUILD {
  my $self = shift;
  $self->cl->enable_ssl if $self->config->{ssl};
  $self->disabled(1) unless $self->config->{autoconnect};
  $self->cl->reg_cb(
    registered     => sub{$self->registered($_)},
    channel_add    => sub{$self->channel_add(@_)},
    channel_remove => sub{$self->channel_remove(@_)},
    channel_topic  => sub{$self->channel_topic(@_)},
    join           => sub{$self->_join(@_)},
    part           => sub{$self->part(@_)},
    nick_change    => sub{$self->nick_change(@_)},
    ctcp_action    => sub{$self->ctcp_action(@_)},
    publicmsg      => sub{$self->publicmsg(@_)},

lib/App/Alice/IRC.pm  view on Meta::CPAN

  my $self = shift;

  $self->disabled(0);
  $self->increase_reconnect_count;

  $self->cl->{enable_ssl} = $self->config->{ssl} ? 1 : 0;

  # some people don't set these, wtf
  if (!$self->config->{host} or !$self->config->{port}) {
    $self->log(info => "can't connect: missing either host or port");
    return;
  }

  $self->reconnect_count > 1 ? 
    $self->log(info => "reconnecting: attempt " . $self->reconnect_count)
  : $self->log(debug => "connecting");

  $self->cl->connect(
    $self->config->{host}, $self->config->{port}
  );
}

sub connected {
  my ($self, $cl, $err) = @_;

  if (defined $err) {
    $self->log(info => "connect error: $err");
    $self->reconnect();
    return;
  }

  $self->log(info => "connected");
  $self->reset_reconnect_count;
  $self->connect_time(time);
  $self->is_connected(1);

  $self->cl->register(
    $self->nick, $self->config->{username},
    $self->config->{ircname}, $self->config->{password}
  );

  $self->broadcast({
    type => "action",
    event => "connect",
    session => $self->alias,
    windows => [map {$_->serialized} $self->windows],
  });
}

sub reconnect {
  my ($self, $time) = @_;

  my $interval = time - $self->connect_time;

  if ($interval < 15) {
    $time = 15 - $interval;
    $self->log(debug => "last attempt was within 15 seconds, delaying $time seconds")
  }

  if (!defined $time) {
    # increase timer by 15 seconds each time, until it hits 5 minutes
    $time = min 60 * 5, 15 * $self->reconnect_count;
  }

  $self->log(debug => "reconnecting in $time seconds");
  $self->reconnect_timer(
    AnyEvent->timer(after => $time, cb => sub {
      $self->connect unless $self->is_connected;
    })
  );
}

sub cancel_reconnect {
  my $self = shift;
  $self->reconnect_timer(undef);
  $self->reset_reconnect_count;
}

sub registered {
  my $self = shift;
  my @log;

  $self->cl->enable_ping (300, sub {
    $self->is_connected(0);
    $self->log(debug => "ping timeout");
    $self->reconnect(0);
  });
  
  for (@{$self->config->{on_connect}}) {
    push @log, "sending $_";
    $self->send_raw($_);
  }
  
  # merge auto-joined channel list with existing channels
  my @channels = uniq @{$self->config->{channels}}, $self->channels;
    
  for (@channels) {
    push @log, "joining $_";
    $self->send_srv("JOIN", split /\s+/);
  }
  
  $self->log(debug => \@log);
};

sub disconnected {
  my ($self, $cl, $reason) = @_;
  delete $self->{disconnect_timer} if $self->{disconnect_timer};
  
  $reason = "" unless $reason;
  return if $reason eq "reconnect requested.";
  $self->log(info => "disconnected: $reason");
  
  $self->broadcast(map {
    $_->format_event("disconnect", $self->nick, $reason),
  } $self->windows);
  
  $self->broadcast({
    type => "action",
    event => "disconnect",
    session => $self->alias,
    windows => [map {$_->serialized} $self->windows],
  });
  
  $self->is_connected(0);
  $self->clear_nicks;
  
  if ($self->app->shutting_down and !$self->app->connected_ircs) {
    $self->shutdown;
    return;
  }
  
  $self->reconnect(0) unless $self->disabled;
  
  if ($self->removed) {
    $self->app->remove_irc($self->alias);
    undef $self;
  }
}

sub disconnect {
  my ($self, $msg) = @_;

  $self->disabled(1);
  if (!$self->app->shutting_down) {
    $self->app->remove_window($_) for $self->windows; 
  }

  $msg ||= $self->app->config->quitmsg;
  $self->log(debug => "disconnecting: $msg") if $msg;
  $self->send_srv(QUIT => $msg);
  $self->{disconnect_timer} = AnyEvent->timer(
    after => 1,
    cb => sub {
      delete $self->{disconnect_timer};
      $self->cl->disconnect($msg);
    }
  );
}

sub remove {
  my $self = shift;
  $self->removed(1);
  $self->disconnect;
}

sub publicmsg {
  my ($self, $cl, $channel, $msg) = @_;
  utf8::decode($channel);
  if (my $window = $self->find_window($channel)) {
    my $nick = (split '!', $msg->{prefix})[0];
    return if $self->app->is_ignore($nick);
    my $text = $msg->{params}[1];
    utf8::decode($_) for ($text, $nick);
    $self->app->store(nick => $nick, channel => $channel, body => $text);
    $self->broadcast($window->format_message($nick, $text)); 
  }
}

sub privatemsg {
  my ($self, $cl, $nick, $msg) = @_;
  my $text = $msg->{params}[1];
  utf8::decode($_) for ($nick, $text);
  if ($msg->{command} eq "PRIVMSG") {
    my $from = (split /!/, $msg->{prefix})[0];
    utf8::decode($from);
    return if $self->app->is_ignore($from);
    my $window = $self->window($from);
    $self->app->store(nick => $from, channel => $from, body => $text);
    $self->broadcast($window->format_message($from, $text)); 
    $self->send_srv(WHO => $from) unless $self->includes_nick($from);
  }
  elsif ($msg->{command} eq "NOTICE") {
    $self->log(debug => $text);
  }
}

sub ctcp_action {
  my ($self, $cl, $nick, $channel, $msg, $type) = @_;
  utf8::decode($_) for ($nick, $msg, $channel);
  return if $self->app->is_ignore($nick);
  if (my $window = $self->find_window($channel)) {
    my $text = "• $msg";
    $self->app->store(nick => $nick, channel => $channel, body => $text);
    $self->broadcast($window->format_message($nick, $text));
  }
}

sub nick_change {
  my ($self, $cl, $old_nick, $new_nick, $is_self) = @_;
  utf8::decode($_) for ($old_nick, $new_nick);
  $self->nick_cached($new_nick) if $is_self;
  $self->rename_nick($old_nick, $new_nick);
  $self->broadcast(
    map  {$_->format_event("nick", $old_nick, $new_nick)}