Jabber IRC クライアント

Net::XMPP2はめんどくさい

せっかくサーバを作ったので，今度はクライアントを作ってみました．なんとか動いたものの，ものすごくきたないです．Net::XMPP2がRPCをサポートしてくれていれば何の問題もなかったのですが，それがないので苦労しました．サーバを作るのに使ったJabber::RPCは外部コンポーネント用としては使えるのですが，TLSをサポートしていないので，普通のクライアントとしては使えません．

request

今回はNet::XMPP2::IM::Connectionを使っています．このモジュールでは，send_iqというメソッドでiqを送受信できます．

send_iq ($type, $create_cb, $result_cb, %attrs)

$typeはJabber RPCの場合"set"になります．$create_cbはNet::XMPP2::Writerがネットに書き出すための情報をノードの形式で渡します．$result_cbはサーバからレスポンスが返って来た時の処理を書き，%attrsはメッセージを送信するために必要なtoやfromの情報を書きます．簡単な方から書いて行くと，まず%attrsはこんな感じ．

            to   => 'jrpc.xmpp.foo.co.jp',
            from => 'bot@xmpp.foo.co.jp',

次に$result_cbはこんな感じ．find_allの使い方がわからなくて，ここでえらく時間を食いました．現状は文字列（string）を出力するようにハードコードしていますが，これは後で修正するつもりです．

            sub {
                my ( $n, $e ) = @_;
                die "iq error : " . $e->string . "\n" if ($e);
                my ($q) = $n->find_all(
                    ['jabber:iq:rpc','query'],
                    ['jabber:iq:rpc','methodResponse'],
                    ['jabber:iq:rpc','params'],
                    ['jabber:iq:rpc','param'],
                    ['jabber:iq:rpc','value'],
                    ['jabber:iq:rpc','string']
                );
                print $q->text,"\n";
            },

問題なのは，$create_cbです．こんな物手動で書くなんて絶対変です．なんとかしたいと思うんだけど，Jabber rpcだけを考えると，パラメータの所をテンプレートにすればいいだけかも．

            sub {
                my ($w) = @_;
                simxml(
                    $w,
                    defns => 'jabber:iq:rpc',
                    node => {
                        name   => 'query',
                        ns     => 'jabber:iq:rpc',
                        childs => [
                            {
                                name   => 'methodCall',
                                childs => [
                                    {
                                        name   => 'methodName',
                                        childs => [ 'examples.getStateName' ],
                                    },
                                    {
                                        name   => 'params',
                                        childs => [
                                            {
                                                name   => 'param',
                                                childs => [
                                                    {
                                                        name   => 'value',
                                                        childs => [
                                                            {
                                                                name   => 'i4',
                                                                childs => [ 6 ],
                                                            }
                                                        ],
                                                    }
                                                ],
                                            }
                                        ],
                                    },
                                ],
                            }
                        ],
                    }
                );
            },

複雑なんだけど，やってることは大したことなくて，

<iq type='set' 
    from='bot@xmpp.foo.co.jp' 
    to='jrpc.xmpp.foo.co.jp' 
    id='rpc1'>
  <query xmlns='jabber:iq:rpc'>
    <methodCall>
      <methodName>examples.getStateName</methodName>
      <params>
        <param>
          <value><i4>6</i4></value>
        </param>
      </params>
    </methodCall>
  </query>
</iq>

を送ろうとしてるだけです．

source

全体はこんな感じになりました．

#!/opt/perl/bin/perl
use strict;
use utf8;
use AnyEvent;
use Net::XMPP2::Util qw/simxml/;
use Net::XMPP2::IM::Connection;

my $j = AnyEvent->condvar;

my $con = Net::XMPP2::IM::Connection->new(
    jid              => 'bot@xmpp.foo.co.jp',
    password         => 'secret',
    initial_presence => -10,
    debug            => 1
);

$con->reg_cb(
    session_ready => sub {
        my ($con) = @_;
        print "Connected as " . $con->jid . "\n";

        $con->send_iq(
            'set',    # type
            sub {
                my ($w) = @_;
                simxml(
                    $w,
                    defns => 'jabber:iq:rpc',
                    node => {
                        name   => 'query',
                        ns     => 'jabber:iq:rpc',
                        childs => [
                            {
                                name   => 'methodCall',
                                childs => [
                                    {
                                        name   => 'methodName',
                                        childs => [ 'examples.getStateName' ],
                                    },
                                    {
                                        name   => 'params',
                                        childs => [
                                            {
                                                name   => 'param',
                                                childs => [
                                                    {
                                                        name   => 'value',
                                                        childs => [
                                                            {
                                                                name   => 'i4',
                                                                childs => [ 6 ],
                                                            }
                                                        ],
                                                    }
                                                ],
                                            }
                                        ],
                                    },
                                ],
                            }
                        ],
                    }
                );
            },
            sub {
                my ( $n, $e ) = @_;
                die "iq error : " . $e->string . "\n" if ($e);
                my ($q) = $n->find_all(
                    ['jabber:iq:rpc','query'],
                    ['jabber:iq:rpc','methodResponse'],
                    ['jabber:iq:rpc','params'],
                    ['jabber:iq:rpc','param'],
                    ['jabber:iq:rpc','value'],
                    ['jabber:iq:rpc','string']
                );
                print $q->text,"\n";
            },
            to   => 'jrpc.xmpp.foo.co.jp',
            from => 'bot@xmpp.foo.co.jp',
        );
    },
    error => sub {
        my ( $con, $error ) = @_;
        warn "Error: " . $error->string . "\n";
    },
    disconnect => sub {
        my ( $con, $h, $p, $reason ) = @_;
        warn "Disconnected from $h:$p: $reason\n";
        $j->broadcast;
    }
);

print "Trying to connect...\n";
$con->connect();

$j->wait;

かなり作り込まないときれいなコードにはならない感じです．