use Moose

Jabber Channel Bot

Google waveでJabberを拡張したプロトコルを使うという話もあって，またJabberが盛り上がってきそうな今日このごろ，Channel（というかチャットルームと言った方がわかりやすい気もします）に投稿するBotを作ってみました．以前IRC用に作ったスクリプトのJabber版です．最近の流行に乗ってMooseを使ってみることにしました．使い方はこんな感じです．

#!/usr/local/bin/perl
use strict;
use warnings;
use MyBot;

main() unless caller();

sub main {
    my $bot = MyBot->new(
        jid      => 'bot0@jabber.foo.co.jp',
        passwd   => 'password',
        chatRoom => 'lanman@conference.jabber.foo.co.jp',
        debug    => 1
    );
    $bot->run;
}

"main() unless caller()"は何かのスクリプトで見たのをそのまま使ったので，特に深い意味はありません．というかこの使い方の意味がわかってないです．今回使用したjabberサーバはejabberdなので，デフォルトでのチャットルームのjidは，"チャットルーム名＠conference.サーバのfqdn"となります．それから，"debug => 1"はAnyEvent::XMPPのdebugモードを制御していて，何もしない0がデフォルト値になります．

MyBotのソース

AnyEvent::XMPPのsampleについてきたスクリプトをほとんどそのまま使用しています．serverPortで指定したportで待っていて，ここで受け付けたテキストをChatroomに投げる仕組みです．セキュリティは勘案してなくて，ホントにテストのためにのみ作っています．

package MyBot;

use Moose;
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Ext::Disco;
use AnyEvent::XMPP::Ext::Version;
use AnyEvent::XMPP::Ext::MUC;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::Util qw/node_jid res_jid/;

has 'anyeventCondvar' => (
    is         => 'rw',
    isa        => 'AnyEvent::CondVar',
    lazy_build => 1,
);

has 'chatRoom' => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
);

has 'connectMessage' => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
    default  => 'Bot started!',
);

has 'jid' => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
);

has 'passwd' => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
);

has 'presence' => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
    default  => "Bot sample",
);

has 'serverPort' => (
    is       => 'rw',
    isa      => 'Int',
    required => 1,
    default  => 34832,
);

has 'tcpServer' => (
    is  => 'rw',
    isa => 'AnyEvent::Handle',
);

has 'xmppClient' => (
    is         => 'rw',
    isa        => 'AnyEvent::XMPP::Client',
    lazy_build => 1,
);

has 'debug' => (
    is       => 'rw',
    isa      => 'Int',
    required => 1,
    default  => 0,
);

__PACKAGE__->meta->make_immutable;

no Moose;

sub _build_anyeventCondvar {
    return AnyEvent->condvar;
}

sub _build_xmppClient {
    my $self = shift;

    my $cl = AnyEvent::XMPP::Client->new( debug => $self->debug );

    my $disco   = AnyEvent::XMPP::Ext::Disco->new;
    my $version = AnyEvent::XMPP::Ext::Version->new;
    my $muc     = AnyEvent::XMPP::Ext::MUC->new( disco => $disco );

    $cl->add_extension($disco);
    $cl->add_extension($version);
    $cl->add_extension($muc);
    $cl->set_presence( undef, $self->presence, 1 );
    $cl->add_account( $self->jid, $self->passwd );

    $cl->reg_cb(
        session_ready => sub {
            my ( $cl, $acc ) = @_;
            $muc->join_room( $acc->connection, $self->chatRoom,
                node_jid( $acc->jid ) );
        },
        contact_request_subscribe => sub {
            my ( $cl, $acc, $roster, $contact ) = @_;
            $contact->send_subscribed;
        },
        connected => sub {
            $cl->send_message( $self->connectMessage, $self->chatRoom,
                $self->jid, 'groupchat' );
            0;
        },
    );

    $self->xmppClient($cl);
}

sub tcp_server_setup {
    my $self = shift;

    AnyEvent::Socket::tcp_server undef, $self->serverPort, sub {
        my ( $clsock, $host, $port ) = @_;
        $self->tcpServer(
            AnyEvent::Handle->new(
                fh       => $clsock,
                on_error => sub { print "Client connection error:\n" }
            )
        );
        $self->tcpServer->push_read(
            line => sub {
                my ( undef, $line ) = @_;
                $self->xmppClient->send_message( $line, $self->chatRoom,
                    $self->jid, 'groupchat' );
                $self->tcpServer->on_drain(
                    sub {
                        $self->tcpServer->fh->close;
                        $self->tcpServer();
                    }
                );
            }
        );
    };
}

sub run {
    my $self = shift;

    $self->tcp_server_setup;

    $self->xmppClient->start;
    $self->anyeventCondvar->wait;
}

1;

注意しないといけないのは，"$cl->send_message()"の第4引数です．チャットルームに投稿する場合，ここで指定するメッセージタイプは'groupchat'になります．