AnyEvent::SKKServを書いた

ついカッとなって。(AquaSKKの新しいバージョンが出たので)

もともとgoogle-ime-skkというものがあって、これはGoogle CGI APIを利用してSKKにGoogle日本語入力のエッセンスを加えるskkserv(辞書サーバ)。地味に便利で手放せないものになっていたんだけど、~~AquaSKKが新しくなってからgoogle-ime-skkがうまく動かなくなってしまった(cacheあたりがあやしい)~~*1。なので、とりあえずAnyEventで書いちゃえと思って書いてしまった…。
とりあえずで書いたら適当になってしまったgoogle-ime-skkの例:

use strict;
use warnings;
use utf8;
use AnyEvent;
use AnyEvent::HTTP;
use AnyEvent::SKKServ;
use Cache::Memory::Simple;
use Encode;
use JSON;
use URI;

our $GOOGLE_IME_URL = 'http://www.google.com/transliterate';

my $cache = Cache::Memory::Simple->new();
my $expire = 60 * 60 * 24;

my $json = JSON->new->utf8(1)->relaxed(1);

my $skkserv = AnyEvent::SKKServ->new(
    port => 55100,
    on_request => sub {
        my ($hdl, $req) = @_;
        $req = decode('euc-jp', $req);
        $req =~ s/([a-z])$/,$1/; # 書く => かk

        if (my $val = $cache->get($req)) {
            $hdl->push_write("1/$val\n");
        } else {
            my $uri = URI->new($GOOGLE_IME_URL);
            $uri->query_form(
                langpair => 'ja-Hira|ja',
                text     => encode_utf8($req),
            );
            http_get $uri, timeout => 1, sub {
                my $res = $json->decode($_[0]);
                my $val = join '/', @{$res->[0][1]};
                $val = encode('euc-jp', $val);

                $hdl->push_write("1/$val\n");

                $cache->set($req => $val, $expire);
            };
        }
    },
);
$skkserv->run;

AE::cv()->recv;

もう少し使ってみて問題なければCPANにアップしよう。

追記

細かいところを直した。

送り仮名がついているものを無視する(書く => かk)
複数の変換候補があるものは無視する(たびにでる => [度に, 旅に, 足袋に], [出る])

use strict;
use warnings;
use utf8;
use AnyEvent;
use AnyEvent::HTTP;
use AnyEvent::SKKServ;
use Cache::Memory::Simple;
use Encode;
use JSON;
use URI;

use constant {
    SERVER_ERROR     => '0',
    SERVER_FOUND     => '1',
    SERVER_NOT_FOUND => '4',
    SERVER_FULL      => '9',
};

my $cache = Cache::Memory::Simple->new();
my $expire = 60 * 60 * 24;

my $json = JSON->new->utf8(1)->relaxed(1);

my $_uri = URI->new('http://www.google.com/transliterate');
sub _uri {
    my $text = shift;
    my $uri = $_uri->clone;
    $uri->query_form(
        langpair => 'ja-Hira|ja',
        text     => encode_utf8($text),
    );
    return $uri;
}

my $skkserv = AnyEvent::SKKServ->new(
    port => 55100,
    on_request => sub {
        my ($hdl, $req) = @_;
        $req = decode('euc-jp', $req);

        my $server_found = sub {
            my $val = shift;
            $hdl->push_write(SERVER_FOUND . "/$val\n");
        };
        my $server_not_found = sub {
            $hdl->push_write(SERVER_NOT_FOUND . "\n");
        };

        # okuri-ari entry
        if ($req =~ /([a-z])$/) {
            $server_not_found->();
        }

        if (my $val = $cache->get($req)) {
            if ($val eq '*') {
                $server_not_found->();
            } else {
                $server_found->($val);
            }
        } else {
            http_get _uri($req), timeout => 1, sub {
                my $res = $json->decode($_[0]);
                if (@$res == 1) {
                    my $val = join '/', @{$res->[0][1]};
                    $val = encode('euc-jp', $val);
                    $server_found->($val);

                    $cache->set($req => $val, $expire);
                } else {
                    $server_not_found->();

                    $cache->set($req => '*', $expire);
                }
            };
        }
    },
);
$skkserv->run;

AE::cv()->recv;

*1:勘違いかもしれない