ついカッとなって。(AquaSKKの新しいバージョンが出たので)
akiym/AnyEvent-SKKServ · GitHub
もともと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/;
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");
};
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;