CaboCha をサーバ化して起動時間を節約する

概要

構文解析器 CaboCha は、実際の1文あたりの処理時間はそれなりに速い（計算機の処理速度が大幅に向上している現代では）のですが、起動時に大きなモデルファイルを読み込む必要があるため、起動にはそれなりに時間がかかります。対話エンジンなどのレイテンシが重要なプログラムでは、この起動時間が大きなネックとなる場合があります。1回の応答生成の度に、CaboCha を起動し直していたのでは、応答時間が遅くなってテンポの良い対話ができなくなってしまうわけです。

本稿では、CaboCha をサーバとして常駐させておくことにより、起動時間を節約してレイテンシを改善する方法を示します。

本稿の方法は、サーバとクライアントからなります。サーバ側は、指定されたポートで待ち受ける HTTP サーバとして動作します。/cabocha?文字列 という GET リクエストのみに反応して、指定された文字列を CaboCha で解析し、解析結果を回答します。クライアント側は、指定されたサーバとポートに対して /cabocha?文字列 という GET リクエストを送り、結果を受け取るだけの動作をします。

注意点

本稿のコードは Proof of Concept として示すものであり、実際の運用にあたっては必須となる、セキュリティ上の対策や考慮を一切していません。利用にあたっては、各自の環境に合わせて、適切に修正を行ってください。

サーバ

cabocha-server.pl

#!/usr/bin/perl

# 指定された文を cabocha を使って構文解析した結果を返す HTTP サーバー

# libwww-perl <URL: http://search.cpan.org/~gaas/libwww-perl/> のイン
# ストールが必要．

use Class::Struct;
use English qw/ $POSTMATCH /;
use Getopt::Long;
use HTTP::Daemon;
use HTTP::Response;
use HTTP::Status;
use IO::Pipe;
use strict;

&struct( process => { read => '$', write => '$', pid => '$' } );

# オプションの解析
our $PORT = 8080;
our $VERBOSE = 1;
&GetOptions( "port=i", \$PORT, "verbose!" => \$VERBOSE );

# 本体
&daemon( $PORT );

# cabocha プロセスにアクセスするための構造体を保持する大域変数
our $CABOCHA;

# cabocha を呼び出し，その結果を表現する HTTP::Response オブジェクトを返す関数
sub cabocha {
    my( $str ) = @_;
    print "INPUT: $str\n" if $VERBOSE;
    $CABOCHA ||= process->open( "cabocha", "-f3" );
    $CABOCHA->write->print( "$str\n" );
    $CABOCHA->write->flush();
    my @buf;
    while( my $s = $CABOCHA->read->getline() ){
        print "OUTPUT: $s" if $VERBOSE;
        push( @buf, $s );
        last if $s =~ m!\A</sentence>\r?\n\Z!;
    }
    my $res = HTTP::Response->new( RC_OK );
    $res->content_type( "text/xml; charset=UTF-8" );
    $res->content( join( "", @buf ) );
    $res;
}

# 子プロセスを fork し，そのプロセスと通信するためのパイプを準備する関数
sub process::open {
    my( $class, @argv ) = @_;
    my $read  = new IO::Pipe;
    my $write = new IO::Pipe;
  FORK: {
        if( my $pid = fork ){
            $read->reader;
            $write->writer;
            return $class->new( pid   => $pid,
                                read  => $read,
                                write => $write );
        } elsif( defined $pid ){
            $write->reader;
            $read->writer;
            STDOUT->fdopen( $read, "w" );
            STDERR->fdopen( $read, "w" );
            STDIN->fdopen( $write, "r" );
            exec join( " ", @argv );
            exit 0;
        } elsif( $! =~ /No more process/ ){
            sleep 5;
            redo FORK;
        } else {
            die "Can't fork: $!\n";
        }
    }
}

# HTTP サーバ本体
sub daemon {
    my( $port ) = @_;
    my $daemon = HTTP::Daemon->new( LocalPort => $port ) || die;
    while( my $c = $daemon->accept ){
        while( my $r = $c->get_request ){
            if( $r->method eq 'GET' and $r->uri =~ m!\A/cabocha\?! ){
                my $x = &url_decode( $POSTMATCH );
                $x =~ s/^\s+//;
                $x =~ s/\s+$//;
                if( $x ){
                    $c->send_response( &cabocha( $x ) );
                } else {
                    $c->send_error( RC_NOT_FOUND );
                }
            } else {
                $c->send_error( RC_FORBIDDEN );
            }
        }
        $c->close;
        undef($c);
    }
}

sub url_decode {
    my( $str ) = @_;
    $str =~ s/%([\da-fA-F]{2})/chr (hex ($1))/eg;
    $str;
}

クライアント

cabocha-client.pl

#!/usr/bin/perl

# 指定された文を cabocha-server.pl を使って構文解析する

# libwww-perl <URL: http://search.cpan.org/~gaas/libwww-perl/> のイン
# ストールが必要．

use Getopt::Long;
use LWP::UserAgent;
use strict;
use utf8;
use open qw/ :utf8 :std /;

our $SERVER = "localhost";
our $PORT   = 8080;
&GetOptions( "server=s" => \$SERVER, "port=i" => \$PORT );

my $agent = LWP::UserAgent->new( keep_alive => 1, timeout => 60 );
while( <> ){
    s/^\s+//;
    s/\s+$//;
    if( $_ ){
        my $url = sprintf( "http://%s:%d/cabocha?%s", $SERVER, $PORT, &url_encode($_) );
        if( my $res = $agent->get( $url ) ){
            print $res->decoded_content;
        }
    }
}

sub url_encode {
    my( $str ) = @_;
    $str =~ s/([\x00-\x20"#%;<>?{}|\\\\^~`\[\]\x7F-\xFF])/sprintf ('%%%x', ord ($1))/eg;
    $str;
}