view release on metacpan or  search on metacpan

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

  }

  $EVENTS{$name} = $code;
}

irc_event connect => sub {
  my ($self, $irc, $err) = @_;
  $irc->is_connecting(0);

  if ($irc->cl->{socket}) {
    $irc->cl->{socket}->rbuf_max(1024 * 10); # 10K max read buffer
  }

  if (defined $err) {
    $self->send_info($irc->name, "connect error: $err");
    $self->reconnect_irc($irc->name);
    return;
  }

  $self->send_info($irc->name, "connected");
  $irc->connect_time(time);

  $self->broadcast({
    type => "action",
    event => "connect",
    network => $irc->name,
  });

  my $config = $self->config->servers->{$irc->name};

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

irc_event registered => sub {
  my ($self, $irc) = @_;
  my $config = $self->config->servers->{$irc->name};

  $irc->reset_reconnect_count;
  $irc->cl->{connected} = 1; # AE::IRC seems broken here...

  my @commands = ();

  push @commands, map {
    my $command = $_;
    sub {
      $self->send_info($irc->name, "sending $command");
      $irc->send_raw($command);
    }
  } @{$config->{on_connect}};

  push @commands, map {
    my $channel = $_;
    sub {
      $self->send_info($irc->name, "joining $channel");
      $irc->send_srv("JOIN", split /\s+/, $channel);
    }
  } @{$config->{channels}};
    
  my $t; $t = AE::timer 1, 0.5, sub {
    if (my $command = shift @commands) {
      $command->();
    }
    else {
      undef $t;
    }
  };

  my $name = $irc->name;
  $irc->cl->enable_ping(300 => sub { $self->reconnect_irc($name) });
};

irc_event disconnect => sub {
  my ($self, $irc, $reason) = @_;

  my @windows = grep {$_->network eq $irc->name} $self->windows;
  $self->broadcast({
    type => "action",
    event => "disconnect",
    network => $irc->name,
    windows => [map {$_->serialized} @windows],
  });
  $self->remove_window($_) for map {$_->id} @windows;

  $reason = "" unless $reason;
  return if $reason eq "reconnect requested.";
  $self->send_info($irc->name, "disconnected: $reason");
  
  # TODO - Object::Event bug that prevents object from getting destroyed
  delete $irc->cl->{change_nick_cb_guard} if $irc->cl;

  $irc->cl(undef);

  $self->reconnect_irc($irc->name, 0) unless $irc->disabled;

  if ($irc->removed) {
    $self->remove_irc($irc->name);
  }
};

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

  if (my $window = $self->find_window($channel, $irc)) {
    my ($nick) = split_prefix($msg->{prefix});
    my $text = $msg->{params}[1];

    return if $self->is_ignore(msg => $nick);

    $self->send_message($window, $nick, $text); 
  }
};

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

  my $text = $msg->{params}[1];
  my ($from) = split_prefix($msg->{prefix});

  if ($msg->{command} eq "PRIVMSG") {

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

      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;