view release on metacpan or  search on metacpan

lib/Alice/Role/IRCEvents.pm  view on Meta::CPAN

irc_event channel_remove => sub {
  my ($self, $irc, $msg, $channel, @nicks) = @_;

  if (my $window = $self->find_window($channel, $irc)) {
    $self->broadcast(
      $window->nicks_action($irc->channel_nicks($channel))
    );

    unless ($self->is_ignore(part => $channel)) {
      my $reason = "";

      if ($msg and $msg->{command} eq "QUIT") {
        $reason = $msg->{params}[-1] || "Quit";
      }

      $self->broadcast(
        map {$window->format_event(left => $_, $reason)} @nicks
      );
    }
  }
};

irc_event channel_topic => sub {
  my ($self, $irc, $channel, $topic, $nick) = @_;
  if (my $window = $self->find_window($channel, $irc)) {
    $topic = irc_to_html($topic, classes => 1, invert => "italic");
    $window->topic({string => $topic, author => $nick, time => time});
    $self->broadcast($window->format_event("topic", $nick, $topic));
  }
};

irc_event irc_invite => sub {
  my ($self, $irc, $msg) = @_;

  my (undef, $channel) = @{$msg->{params}};
  my ($from) = split_prefix($msg->{prefix});

  my $message = "$from has invited you to $channel on ".$irc->name;
  $self->announce($message);
};

irc_event 464 => sub{
  my ($self, $irc, $msg) = @_;
  $self->disconnect_irc($irc->name, "bad USER/PASS")
};

irc_event [qw/001 305 306 401 471 473 474 475 477 485 432 433/] => sub {
  my ($self, $irc, $msg) = @_;
  $self->send_info($irc->name, $msg->{params}[-1]);
};

irc_event [qw/372 377 378/] => sub {
  my ($self, $irc, $msg) = @_;
  $self->send_info($irc->name, $msg->{params}[-1], mono => 1);
};

sub reconnect_irc {
  my ($self, $name, $time) = @_;
  my $irc = $self->get_irc($name);
  throw InvalidNetwork "$name isn't one of your networks" unless $irc;

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

  if ($interval < 15) {
    $time = 15 - $interval;
    $self->send_info($irc->name, "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 * $irc->reconnect_count;
  }

  $self->send_info($irc->name, "reconnecting in $time seconds");
  $irc->reconnect_timer(AE::timer $time, 0, sub {$self->connect_irc($name)});
}

sub disconnect_irc {
  my ($self, $name, $msg) = @_;
  my $irc = $self->get_irc($name);
  throw InvalidNetwork "$name isn't one of your networks" unless $irc;

  if ($irc->reconnect_timer) {
    $self->cancel_reconnect($name);
    return;
  }

  throw DisconnectError "$name is already disconnected" if $irc->is_disconnected;

  $self->send_info($irc->name, "disconnecting: $msg") if $msg;
  $irc->is_connecting(0);
  $irc->disabled(1);
  $msg ||= $self->config->quitmsg;
  $irc->cl->disconnect($msg);
}

sub cancel_reconnect {
  my ($self, $name) = @_;
  my $irc = $self->get_irc($name);
  throw InvalidNetwork "$name isn't one of your networks" unless $irc;

  $self->send_info($irc->name, "canceled reconnect");
  $self->broadcast({
    type => "action",
    event => "disconnect",
    network => $irc->name,
    windows => [], #shouldn't be any windows if we're not connected.
  });
  $irc->reconnect_timer(undef);
  $irc->reset_reconnect_count;
}

sub connect_irc {
  my ($self, $name) = @_;
  my $irc = $self->get_irc($name);

  throw InvalidNetwork "$name isn't one of your networks" unless $irc;
  throw ConnectError "$name is already connected" if $irc->is_connected;
  throw ConnectError "$name is already connecting" if $irc->is_connecting;

  $irc->reconnect_timer(undef);
  my $config = $self->config->servers->{$irc->name};
 
  # some people don't set these, wtf
  if (!$config->{host} or !$config->{port}) {
    $self->send_info($irc->name, "can't connect: missing either host or port");
    return;
  }

  my $events = $self->build_events($irc);
  $irc->new_client($events, $config);
  $irc->disabled(0);
  $irc->increase_reconnect_count;
   
  $self->send_info($irc->name, "connecting (attempt " . $irc->reconnect_count .")");
  
  $irc->is_connecting(1);
  $irc->cl->connect($config->{host}, $config->{port});
}

1;