AnyEvent-IRC-Server

 view release on metacpan or  search on metacpan

lib/AnyEvent/IRC/Server.pm  view on Meta::CPAN

            my ($irc, $msg, $handle) = @_;
            $say->( $handle, 'PONG', $msg->{params}->[0]);
        },
    );
    return $self;
}

sub _server_comment {
    my ($self, $nick) = @_;
    return sprintf '%s!~%s@%s', $nick, $nick, $self->servername;
}

sub _send_chan_msg {
    my ($self, $nick, $chan, @args) = @_;
    # send join message
    my $handle = $self->channels->{$chan}->{handles}->{$nick};
    my $comment = sprintf '%s!%s@%s', $nick, $handle->{user} || $nick, $handle->{servername} || $self->servername;
    my $raw = mk_msg_ex($comment, @args);
    debugf("_send_chan_msg: %s", $raw);
    $raw .= $CRLF;
    if ($self->is_channel_name($chan)) {
        for my $handle (values %{$self->channels->{$chan}->{handles}}) {
            next unless $handle->{nick};
            next if $handle->{nick} eq $nick;
            next if $self->spoofed_nick->{$handle->{nick}};
            $handle->push_write($raw);
        }
    } else {
        # private talk
        # TODO: TOO SLOW
        my $handle = $self->nick2handle->{$chan};
        if ($handle) {
            $handle->push_write($raw);
        }
    }
}

sub run {
    my $self = shift;
    tcp_server $self->{host}, $self->{port}, sub {
        my ($fh, $host, $port) = @_;
        my $handle = AnyEvent::Handle->new(
            on_error => sub {
                my ($handle) = @_;
                $self->event('on_error' => $handle);
            },
            on_eof => sub {
                my ($handle) = @_;
                $self->event('on_eof' => $handle);
                # TODO: part from each channel
                if (my $nick = $handle->{nick}) {
                    delete $self->nick2handle->{$nick};
                }
                delete $self->handles->{refaddr($handle)};
            },
            fh => $fh,
        );
        $handle->{nick} = '*';
        $handle->on_read(sub {
            $handle->push_read(line => sub {
                my ($handle, $line, $eol) = @_;
                my $msg = parse_irc_msg($line);
                $self->handle_msg($msg, $handle);
            });
        });
        $self->handles->{refaddr($handle)} = $handle;
    }, $self->prepared_cb();
}

sub handle_msg {
    my ($self, $msg, $handle) = @_;
    my $event = lc($msg->{command});
       $event =~ s/^(\d+)$/irc_$1/g;
    debugf("%s %s", $event, $msg);
    $self->event($event, $msg, $handle);
}

# -------------------------------------------------------------------------

sub add_spoofed_nick {
    my ($self, $nick) = @_;
    $self->{spoofed_nick}->{$nick} = 1;
}


# -------------------------------------------------------------------------

sub daemon_cmd_join {
    my ($self, $nick, $chan, $msg) = @_;
    return if $self->channels->{$chan}->{handles}->{$nick};
    $self->add_spoofed_nick($nick);
    $self->_intern_join($nick, $chan, $self->nick2handle->{$nick});
}

sub daemon_cmd_kick {
    my ($self, $kicker, $chan, $kickee, $comment) = @_;
    $self->_intern_kick($kicker, $chan, $kickee, $comment);
}

sub daemon_cmd_topic {
    my ($self, $nick, $chan, $topic) = @_;
    $self->_intern_topic($nick, $chan, $topic);
}

sub daemon_cmd_part {
    my ($self, $nick, $chan, $msg) = @_;
    $self->_intern_part($nick, $chan, $msg);
}

sub daemon_cmd_privmsg {
    my ($self, $nick, $chan, $msg) = @_;
    $self->_intern_privmsg($nick, $chan, $msg);
}

sub daemon_cmd_notice {
    my ($self, $nick, $chan, $msg) = @_;
    debugf('%s', [$nick, $chan, $msg]);
    $self->_intern_notice($nick, $chan, $msg);
}

# -------------------------------------------------------------------------



( run in 2.638 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )