#!/usr/bin/perl
#  Copyright (c) 2003 Nara Institute of Science and Technology
#  All rights reserved.
#  
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. The name Nara Institute of Science and Technology may not be used to
#  endorse or promote products derived from this software without specific
#  prior written permission.
#  
#  THIS SOFTWARE IS PROVIDED BY Nara Institute of Science and Technology 
#  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
#  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
#  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE Nara Institute
#  of Science and Technology BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
#  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
#  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 
#  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 
#  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
#  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
#  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
#  $Id: chasend,v 1.3 2003/07/08 17:27:56 kazuma-t Exp $

use Text::ChaSen;
use Socket;

$SERVER_VERSION = 'أمن¥ protocol 1.0 ChaSen Server 2.0';
$BUFFER_LEN = 8192 - 1;

sub skip_until_dot {
    my ($in) = $_;

    while (<$in>) {
	chomp;
	if (/^\.$/) {
	    break;
	}
    }
}

sub command_dispatch {
    my ($line, $in, $out) = @_;

    chomp($line);
    if ($line =~ /^RUN/i) {
	return run_chasen($in, $out, $line);
    } elsif ($line =~ /^RC/i) {
	print $out "500 Not implimented\n";
    } elsif ($line =~ /^QUIT/i) {
	return 0;
    } elsif ($line =~ /^HELP/i) {
	show_help($out);
    } else {
	print $out "500 What?\n";
	return 1;
    }

    return 1;
}

sub run_chasen {
    my ($in, $out, $args_str) = @_;
    my (@args) = split(/\s/, $args_str);
    shift(@args);
    
    if (Text::ChaSen::getopt_argv($SERVER_VERSION, @args)) {
	skip_until_dot($in);
	print $out "500 Option Error\n";
	return 1;
    }
    
    print $out "200 OK\n";
    while (<$in>) {
	if (length($_) > $BUFFER_LEN) {
	    print $out "500 Line too long\n";
	    skip_until_dot($in);
	    return 1;
	}
	s/\n$//; s/\n\r$//; s/\r$//; # XXX
	return 1 if (/^\.$/);
	s/^\.\././;
	$str = Text::ChaSen::sparse_tostr($_);

	print $out $str;
    }
    print $out ".\n";

    return 0;
}

sub show_help {
    my ($out) = @_;

    print $out "200 OK\n";
    print $out <<EOF;
RUN [options]
  -b          show best path (default)
  -m          show all morphemes
  -p          show all paths

  -f          show formatted morpheme data (default)
  -e          show entire morpheme data
  -c          show coded morpheme data
  -d          show detailed morpheme data
  -v          show detailed morpheme data for ViCha
  -F format   show morpheme with formatted output

  -j          Japanese sentence mode
  -w          specify the cost width
  -C          use command mode (not implimented)

RC            (not implimented)
QUIT
HELP
EOF
    print $out ".\n"
}


#####

my $port = shift || 31000;
my $proto = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!\n";
setsockopt(SOCKET, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
    || die "socketopt: $!\n";

bind(SOCKET, sockaddr_in($port, INADDR_ANY)) || die "bind: $!\n";
listen(SOCKET, SOMAXCONN) || die "listen: $!\n";

$SIG{CHLD} = \&reaper;

my ($sock_addr, $waited_child);
while ($waited_child = 0,
       $sock_addr = accept(CLIENT, SOCKET) || $waited_child) {
    next if $waited_child;

    my ($port, $iaddr) = sockaddr_in($sock_addr);

    select(CLIENT); $| = 1; select(STDOUT);

    my ($pid);
    if ($pid = fork()) {
	close (CLIENT);
    } elsif (defined $pid) {
	print CLIENT "200 Running ChaSen version: ", $SERVER_VERSION, "\n";
	while (<CLIENT>)
	{
	    last unless (command_dispatch($_, CLIENT, CLIENT));
	}
	print CLIENT "205 Quit\n";
	close(client);
	exit 0;
    } else {
	die "fork: $!\n";
    }
}

sub reaper {
    $waited_child = wait();
    $SIG{CHLD} = \&reaper;
}