Server and Client of CaboCha

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;

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->content;
	}
    }
}

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

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=EUC-JP" );
    $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;
}