POE::Component::IRC で遊ぶ

PerlのIRCモジュールと言えば、ちょっと前まで Net::IRCだと思っていたが、久しくcpanでそいつをインストールしようとすると、”時代遅れだからPOE::Component::IRCを使っちゃいなー ! ” と言われた。 イベントドリブンなIRCクライアントを書く為のモジュールで、PING/PONGの自動応答など、IRCセッションを裏で面倒見てくれる便利なモジュールらしい。POE自体、ネットワーク関係の疑似マルチスレッディング、同期通信など、カーネル側でサポートされそうな事をやってくれる便利なパッケージ。これを使うと、よ り環境に依存しないネットワークツールが作れる訳だ。

POE::Component::IRC の日本語ドキュメントもさくっと見つかった。

サンプルがついているので、ちょっと遊んでみる。ついでに、ホスト& IRCサーバともども、UTF-8な日本語環境で利用する為の工夫もしてみた。

</p>

<h1>!/usr/bin/env perl</h1>

<p>use strict;
use warnings;
use utf8;
use Encode;
use POE qw(Component::IRC);</p>

<h1>IRC の接続設定</h1>

<p>my $nickname  = 'poepoe' . $$;
my $ircname   = 'POE POE Bot';
my $ircserver = 'sasebo.ddo.jp';
my $port      = 6665;
my @channels  = ( '#alice' );</p>

<h1>接続設定を渡して、オブジェクトを作成</h1>

<p>my $irc = POE::Component::IRC-&gt;spawn(
    nick    =&gt; $nickname,
    server  =&gt; $ircserver,
    port    =&gt; $port,
    ircname =&gt; $ircname,
) or die &quot;Failed. $!&quot;;</p>

<h1>イベントハンドラを登録</h1>

<p>POE::Session-&gt;create(
    package_states =&gt; [
        'main' =&gt; [ qw(_default _start irc_001 irc_public) ],
    ],
    heap =&gt; {
        irc =&gt; $irc
    },
);</p>

<h1>実行</h1>

<p>$poe_kernel-&gt;run();
exit 0;</p>

<h1>以下、イベント</h1>

<h1>接続</h1>

<p>sub <em>start {
    my ($kernel,$heap) = @</em>[KERNEL,HEAP];
    my $irc_session = $heap-&gt;{irc}-&gt;session_id();
    $kernel-&gt;post( $irc_session =&gt; register =&gt; 'all' );
    $kernel-&gt;post( $irc_session =&gt; connect =&gt; { } );
    undef;
}</p>

<h1>接続完了 → チャンネルへ Join !</h1>

<p>sub irc_001 {
    my ($kernel,$sender) = @<em>[KERNEL,SENDER];
    my $poco_object = $sender-&gt;get_heap();
    print &quot;Connected to &quot;, $poco_object-&gt;server_name(), &quot;\n&quot;;
    $kernel-&gt;post( $sender =&gt; join =&gt; $</em> ) for @channels;
    undef;
}</p>

<h1>発言時や状態が変わった時などに呼ばれるイベント。</h1>

<h1>ここに自由な挙動を書く。</h1>

<p>sub irc_public {
    my ($kernel,$sender,$who,$where,$what) = @_[KERNEL,SENDER,ARG0,ARG1,ARG2];
    my $nick = ( split /!/, $who )[0];
    my $channel = $where-&gt;[0];</p>

<pre><code># 内部 Unicode 用に UTF8 フラグを付与
$what = Encode::decode(&amp;quot;utf-8&amp;quot;,$what);

if ( $what =~ /イ[カモ]/ ) {
    # 本当は、BOT の発言は privmsg ではなく notice にするのがマナー。
    $kernel-&amp;gt;post( $sender =&amp;gt; privmsg =&amp;gt; $channel =&amp;gt; &amp;quot;おいしいです、$nick。&amp;quot; );
}
</code></pre>

<h1>茶筅に投げてみるテスト</h1>

<h1>if ( my ($rot13) = $what =~ /^! (.+)/ ) {</h1>

<h1>foreach my $line (<code>echo '$rot13'|chasen -iw</code>){</h1>

<h1>$kernel-&gt;post( $sender =&gt; notice =&gt; $channel =&gt; $line );</h1>

<h1>}</h1>

<h1>}</h1>

<pre><code># 出力時には、UTF8 フラグを除去
$what = Encode::encode(&amp;quot;utf-8&amp;quot;,$what);
undef;
</code></pre>

<p>}</p>

<h1>標準出力に動作ログを吐く</h1>

<p>sub <em>default {
    my ($event, $args) = @</em>[ARG0 .. $#_];
    my @output = ( &quot;$event: &quot; );
    foreach my $arg ( @$args ) {
        if ( ref($arg) eq 'ARRAY' ) {
                push( @output, &quot;[&quot; . join(&quot; ,&quot;, @$arg ) . &quot;]&quot; );
        } else {
                push ( @output, &quot;'$arg'&quot; );
        }
    }
    print STDOUT join ' ', @output, &quot;\n&quot;;
    return 0;
}

ソースも LOCALE も IRC サーバも UTF-8 だが、Perl の内部保持している文字列データは単純な Unicode なので、UTF-8 フラグを付けてから処理してやらなければならない。 上の例では、「イカ」とか「イモ」という発言があれば反応する。

参考ページ

投稿者:

dyama

佐世保のシステムエンジニアです。詳しいプロフィールやこのブログについてはこちらをご覧ください。

コメントを残す

メールアドレスが公開されることはありません。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください