App-RoboBot

 view release on metacpan or  search on metacpan

lib/App/RoboBot/Network/IRC.pm  view on Meta::CPAN

    default => 0,
);

has 'username' => (
    is  => 'ro',
    isa => 'Str',
);

has 'password' => (
    is  => 'ro',
    isa => 'Str',
);

has 'client' => (
    is      => 'ro',
    isa     => 'AnyEvent::IRC::Client',
    default => sub { AnyEvent::IRC::Client->new },
);

has 'nick_cache' => (
    is      => 'rw',
    isa     => 'HashRef',
    default => sub { {} },
);

sub BUILD {
    my ($self) = @_;

    $self->client->enable_ssl() if $self->ssl;
}

sub connect {
    my ($self) = @_;

    $self->log->info(sprintf('Connecting to IRC server at %s:%s.', $self->host, $self->port));

    $self->client->reg_cb( registered => sub {
        my ($con) = @_;

        $self->client->enable_ping(30, sub {});
    });

    $self->client->reg_cb( publicmsg => sub {
        my ($con, $chan, $msg_h) = @_;
        $self->handle_message($msg_h);
    });

    $self->client->reg_cb( privatemsg => sub {
        my ($con, $sender, $msg_h) = @_;
        $self->handle_message($msg_h);
    });

    $self->client->connect($self->host, $self->port, { nick => $self->nick->name });

    $self->log->info('Connected.');

    $_->join for @{$self->channels};
}

sub disconnect {
    # TODO: remove callbacks
    #       call client->disconnect
}

sub kick {
    my ($self, $response, $nick, $message) = @_;

    return unless $response->has_channel;
    my $channel = '#' . $response->channel->name;

    return unless defined $nick && defined $message && $nick =~ m{\w+} && $message =~ m{\w+};

    $self->client->send_long_message('utf8', 0, "KICK", $channel, $nick, $message);

    return;
}

sub send {
    my ($self, $response) = @_;

    local $Text::Wrap::columns = 400;

    # Make sure that linebreaks are treated as separators for "line" output in IRC,
    # since that isn't always the case for every protocol. And re-wrap any long
    # lines.
    my @output =
        map { length($_) > 300 ? split(/\n/, wrap('', '', $_)) : $_ }
        grep { defined $_ && $_ =~ m{\S+} }
        map { split(/\n/, $_) }
        @{$response->content};

    # TODO: Move maximum number of output lines into a config var for each IRC
    #       network (with a default).
    my $max_lines = 12;

    if (@output > $max_lines) {
        my $n = scalar @output;
        my $split_at = int($max_lines / 2) - 2;

        @output = (
            @output[0..$split_at],
            '... Output Truncated (' . ($n - (($split_at + 1) * 2)) . ' lines removed) ...',
            @output[($n - ($split_at + 1))..($n - 1)]
        );
    }

    my $recipient = $response->has_channel ? '#' . $response->channel->name : $response->nick->name;

    my $d = 0;
    for (my $i = 0; $i <= $#output; $i++) {
        my $line = $output[$i];

        if ($line =~ m{^/me\s+(.+)}) {
            $self->client->send_long_message('utf8', 0, "PRIVMSG\001ACTION", $recipient, $1);
        } else {
            $self->client->send_long_message('utf8', 0, "PRIVMSG", $recipient, $line);
            #$self->client->send_srv( PRIVMSG => $recipient, $line);
        }

        # TODO: Move send rate to a config var which can be overridden per
        #       network.



( run in 1.277 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )