view release on metacpan or  search on metacpan

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

package Alice::IRC;

use AnyEvent;
use AnyEvent::IRC::Client;
use AnyEvent::IRC::Util qw/parse_irc_msg/;
use List::MoreUtils qw/any/;
use Digest::MD5 qw/md5_hex/;
use Any::Moose;
use Encode;

my $email_re = qr/([^<\s]+@[^\s>]+\.[^\s>]+)/;
my $image_re = qr/(https?:\/\/\S+(?:jpe?g|png|gif))/i;

{
  no warnings;

  # YUCK!!!
  *AnyEvent::IRC::Connection::_feed_irc_data = sub {
    my ($self, $line) = @_;
    my $m = parse_irc_msg (decode ("utf8", $line));
    $self->event (read => $m);
    $self->event ('irc_*' => $m);
    $self->event ('irc_' . (lc $m->{command}), $m);
  };

  *AnyEvent::IRC::Connection::mk_msg = \&mk_msg;
  *AnyEvent::IRC::Client::mk_msg = \&mk_msg;
}

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

has 'name' => (
  is       => 'ro',
  required => 1,
);

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

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

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

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

has whois => (
  is        => 'rw',
  default   => sub {{}},
);

has avatars => (
  is        => 'rw',
  default   => sub {{}},
);

sub add_whois {
  my ($self, $nick, $cb) = @_;
  $nick = lc $nick;
  $self->whois->{$nick} = {info => "", cb => $cb};
  $self->send_srv(WHOIS => $nick);
}

sub new_client {
  my ($self, $events, $config) = @_;

  my $client = AnyEvent::IRC::Client->new(send_initial_whois => 1);
  $client->enable_ssl if $config->{ssl};
  $client->reg_cb(%$events);
  $client->ctcp_auto_reply ('VERSION', ['VERSION', "alice $Alice::VERSION"]);

  $self->cl($client);
}

sub send_srv {
  my $self = shift;
  $self->cl->send_srv(@_) if $self->cl;
}

sub send_long_line {
  my ($self, $cmd, @params) = @_;
  my $msg = pop @params;
  my $ident = $self->cl->nick_ident($self->cl->nick);
  my $init_len = length mk_msg($ident, $cmd, @params, " ");

  my $max_len = 500; # give 10 bytes extra margin
  my $line_len = $max_len - $init_len;

  # split up the multiple lines in the message:
  my @lines = split /\n/, $msg;