のみまくし日記

POE::Component::IRCとPOE::Component::Server::HTTPをつかって HTTP Serverな機能を備えたIRCbotを作りました。

HTTP ServerはどんなURLで来ても1ピクセルの画像を出力するだけな単純な仕組みです。

影舞のデータの格納先はDBにしておきます。

影舞の登録完了のHTMLで

/kagemai/resource/ja/template/_default/add_message.rhtml
/kagemai/resource/ja/template/_default/new_report.rhtml

<img src="http://localhost:8888/<%= report.id %>" />

見たいにしておいて、POEで作ったHTTP Serverに通知。HTTP Server ではリクエストされたURLをみれれば、影舞のレポート番号がわかるので、DBに直接聞きに行くと。いった感じ。かなり適当だけど、コードを晒してみます。

#!/usr/bin/perl
# =========================================================================
# BTSからIMGタグアクセスでIRCに告知
#
# =========================================================================
use strict;
use POE qw(
    Component::Server::HTTP
    Component::IRC
    Component::TSTP
);
use POE::Sugar::Args;
use HTTP::Status;
use Jcode;
use LWP::Simple;

use BTS::Data::Report;

# -------------------------------------------------------------------------
# 設定
#
# -------------------------------------------------------------------------
our @CHANNEL = (
    '#BTS',
);
our $NICK     = 'BTS';
our $USERNAME = 'kagemai';
our $IRCNAME  = 'kagemai';
our $SERVER   = 'localhost';
our $PORT     = '6667';


# -------------------------------------------------------------------------
# main
#
# -------------------------------------------------------------------------
POE::Component::TSTP->create(); # Ctrl-Z をトラップする
POE::Component::IRC->new("irc");
POE::Component::Server::HTTP->new(
    Alias => 'httpd',
    Port => 8888,
    ContentHandler => {'/' => \&http_handler},
    Headers => { Server => 'My Server' },
);

POE::Session->create(
    inline_states => {
        _start   => \&setup_service,
        _stop    => \&shutdown_service,
        # _default => \&_debug,
    },
);
$poe_kernel->run;


# -------------------------------------------------------------------------
# デバッグ
#
# -------------------------------------------------------------------------
sub _debug {
    my ( $event, $args ) = @_[ ARG0 .. $#_ ];
    print "unhandled $event\n";

    my $arg_number = 0;
    foreach (@$args) {
        print "  ARG$arg_number = ";
        if ( ref($_) eq 'ARRAY' ) {
            print "$_ = [", join ( ", ", @$_ ), "]\n";
        }
        else {
            print "'$_'\n";
        }
        $arg_number++;
    }
    return 0;    # Don't handle signals.
}


# -------------------------------------------------------------------------
# start, stop
#
# -------------------------------------------------------------------------
sub setup_service { 
    my $poe = sweet_args;

    $poe->kernel->alias_set("btsbot");

    # IRC botのセットアップ
    $poe->kernel->post( irc => register => qw(all) );
    $poe->kernel->post( irc => connect => {
            Nick     => $NICK,
            Username => $USERNAME,
            Ircname  => $IRCNAME,
            Server   => $SERVER,
            Port     => $PORT
        }
    );
}

sub shutdown_service { }

# -------------------------------------------------------------------------
# IRC接続
#
# -------------------------------------------------------------------------
sub on_connect {
    my $poe = sweet_args;

    for my $v (@CHANNEL) {
        $poe->kernel->post(irc => join => jis($v));
    }
}

# -------------------------------------------------------------------------
# 文字コードの変換
#
# -------------------------------------------------------------------------
sub jis {
    return Jcode->new(shift, 'euc')->jis;
}   

sub euc {
    return Jcode->new(shift, 'jis')->euc;
}

# -------------------------------------------------------------------------
# HTTPアクセスでBTSの更新を通知が来る
#
# -------------------------------------------------------------------------
sub http_handler {
    my ($request, $response) = @_;

    send_message($request->uri);

    # http://nais.to/~yto/clog/2004-12-08-4.html
    my $content = "\x47\x49\x46\x38\x39\x61\x01".
    "\x00\x01\x00\x80\xff\x00\xff\xff\xff\x00\x00\x00\x21\xf9".
    "\x04\x01\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x01\x00\x01".
    "\x00\x00\x02\x02\x44\x01\x00\x3b";

    $response->code(RC_OK);
    $response->push_header('Content-type', 'text/gif');
    $response->push_header('Pragma', 'no-cache');
    $response->push_header('Cache-Control', 'no-cache');
    $response->content($content);

    return RC_OK;
}

# -------------------------------------------------------------------------
# BTSの情報をメッセージ送信
#
# -------------------------------------------------------------------------
sub send_message {
    my $request_uri = shift;

    my ($report_id,) = ($request_uri =~ /(\d+)$/);

    #
    # 影舞のからデータ取ってくる
    #
    my $report = BTS::Data::Report->retrieve($report_id);

    POE::Kernel->call(
        irc => privmsg => '#BTS' => jis(sprintf"%s(%s)",
            $report->title,
            $report->status
        )
    );
    POE::Kernel->call(
        irc => privmsg => '#BTS' => jis(sprintf"%s >%s",
            $report->url,
            $report->assigned
        )
    );
}

BTS::Data::Report ってのは影舞で使っているテーブルをClass::DBIを使って定義しておいたヤツ。

参考にしたのは

• http://naoya.dyndns.org/~naoya/mt/archives/000514.html
• http://naoya.dyndns.org/~naoya/mt/archives/000601.html
• http://blog.bulknews.net/cookbook/blosxom/pings/ping_to_hatena_poe.html
• http://poe.perl.org/?POE_Cookbook

ここら辺へんです。