#!/usr/local/bin/perl
#======================================================================
#              Perl & Tcl/Tk visips server model
#    Copyright (C) 1996 Takuya Nakayama <takuya-n@is.aist-nara.ac.jp>
#======================================================================

$HERE = $0;
$HERE =~ s/[^\/]+$//;
$HERE = "./" if !$HERE;

$RC_DEFAULT = $HERE . ".visipsrc";

#--------------------------------------------------------------------
# åȤ SAX ̿
#--------------------------------------------------------------------
while (@ARGV) {
    $op_name = shift @ARGV;
    $val     = shift @ARGV;
    $OPTIONS{$op_name} = $val;
}
if ($OPTIONS{"-inet"}) {
    $AF_INET     = 2;		# INET
    $SOCK_STREAM = 1;		# ȥ꡼෿å
    
    $sockaddr    = 'S n a4 x8';	# sockaddr¤
                                # S  ... sin_family
				# n  ... sin_port
				# a4 ... sin_addr
				# x8 ... ̤

    ($name, $aliases, $proto) = getprotobyname('tcp');
    if ($OPTIONS{"-inet"} !~ /^\d+$/) {
	($name, $aliases, $OPTIONS{"-inet"}) 
	    = getservbyport($OPTIONS{"-inet"}, 'tcp');
    }

    $this = pack($sockaddr, $AF_INET, $OPTIONS{"-inet"}, "\0\0\0\0");
    # åȤ
    socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
    bind(S, $this) || die "bind: $!";   # ̾Ť
    listen(S, 5)   || die "listen: $!"; # դ

    select(S); $| = 1; select(STDOUT);  # Хåե
    #  ᥤ롼
    #
    while (1) {
	($addr = accept(Socket, S)) || die $!;
	
	select(Socket); $| = 1;	select(STDOUT);	# Хåե
	
	$/ = "\0";
	$command = <Socket>;
	chop $command;
	if ($command =~ /visips_server_kill/) {
	    wait;
	    exit(0);
	}
	if ($command =~ /visips_client_start/) {
	    split(' ', $command);
	    $visipsrc = @_[1];
	    $arg_mode = @_[2];
	}
	# ӤʤˤϻҤɤ򻦤¹ 
	unless (fork) {
	    # ҥץ
	    unless (fork) {
		# ¹ץ
		sleep 1 until getppid == 1;	# ҥץޤԤ
		
		&Process(*Socket, $visipsrc, $arg_mode);
		close(Socket);

		exit(0);
	    }
	    exit(0);		# ҥץϤλ
	}
	close(Socket);
	wait;
    }
} else {
    # ƥ
    &Process(*STDIN, $OPTIONS{"-rc"});
}

#--------------------------------------------------------------------
# Υץ
#--------------------------------------------------------------------
sub Process {
    local(*IN, $visipsrc, $arg_mode) = @_;
    local($ret,$tmp,*RC,$mode);

    if (!open(RC, $visipsrc)) {
	if (open(RC, $RC_DEFAULT)) {
	    $visipsrc = $RC_DEFAULT;
	} else {
	    $visipsrc = "default";
	}
    }

    if ($OPTIONS{"-mode"}) {
	$mode = $OPTIONS{"-mode"};
    } else {
	if ($visipsrc ne "default") {
	    $/ = "\n";
	    while (<RC>) {
		if (/set\s+READ_MODE/) {
		    split;
		    $mode = @_[2];
		    last;
		}
	    }
	    close(RC);
	} else {
	    $mode = 1;		# batch ⡼
	}
    }

    if ($arg_mode) {
	if ($arg_mode eq "batch") {
	    $mode = 3 if $mode == 2;
	} else {
	    $mode = 2;
	}
    }
    # ѥ졼 \0 
    $/ = "\0";

    select(IN); $| = 1; select(STDOUT);	# Хåե

    # visips Υǡ --> tk-visips Υǡ
    $ID = 0;
    while (<IN>) {
	chop $_;
	if ($_ eq "w") {
	    $cat_pos = <IN>; chop $cat_pos; $cat_pos--;
	    $cat_len = <IN>; chop $cat_len; $cat_len--;
	    $cat_name = <IN>; chop $cat_name;
	    
	    $cat_pos2 = $cat_pos + $cat_len;
	    $post = "add $ID $cat_pos $cat_len $cat_name\n";

	    $ditail_info = <IN>; chop $ditail_info;
	    $post .= "$ditail_info\n\\e\n";
#	    $post .= "$IDn/add\n";
	    print W1 $post;
	    
	    $child_num = <IN>; chop $child_num;
	    if ($child_num > 0) {
		$post = "\n";
		for ($i = 0; $i < $child_num; $i++) {
		    $tmp = <IN>; chop $tmp;
		    $post = "$tmp $post";
		}
		$post = "setdtr $ID " . $post;

		print W1 $post;
	    } else {
		$post = "setdtr $ID ";
		for ($i = $cat_pos; $i <= $cat_pos2; $i++) {
		    $post .= "i$i ";
		}
		print W1 "$post\n";
	    }
	    $ret = getc(R2);

	    if ($mode == 2) {
		if ($ret == 3) {
		    # mod mode
		    $tmp = "";
		    while (1) {
			$ret = getc(R2);
			if ($ret eq "" || $ret eq "\x0c") {last;}
			$tmp .= $ret;
		    }
		    print IN $ID, "\0", "3\0", $tmp, "\0";
		} else{
		    print IN "$ID\0", "$ret\0";
		}
	    }

	    $ID++;
	} elsif ($_ eq "i") {
	    $display = <IN>; chop $display;
	    &OpenInterface($display,$visipsrc,$mode);

	    $words_number = <IN>; chop $words_number;
	    print W1 "size $words_number\n";
	    getc(R2);

	    print W1 "setstr ";
	    for ($i = 0; $i < $words_number; $i++) {
		$word = <IN>; chop $word;
		print W1 "$word ";
	    }
	    print W1 "\n";
	    getc(R2);
	    
	    $sentence_cat = <IN>; chop $sentence_cat;
	    $init_option = <IN>; chop $init_option;

	} elsif ($_ eq "f") {
	    print W1 "end\n";
	    last;
	}
    }
    print W1 "end\n";
    wait;
    
    exit(0);
}

sub OpenInterface {
    local($display,$visipsrc,$mode) = @_;
    local($exec_file);
    #--------------------------------------------
    # ѥפ Visual Interface ̿
    #--------------------------------------------
    #  W1     -->  STDIN
    #  STDOUT -->  R2
    pipe(R1,W1);
    pipe(R2,W2);

    # ̿ҥץǼ¹
    unless ($pid = fork) {
	#-------------------------------------------
	# ҥץ¦
	#-------------------------------------------
	# פʥեϥɥĤ
	close(W1);
	close(R2);
	# STDIN  R1 ľ
	open(STDIN, "<&R1") ||  die "Error\n";
	# W2  STDOUT ľ
	open(STDOUT, ">&W2") ||  die "Error\n";
	# פʥեϥɥĤ
	close(R1);
	close(W2);
	# Хåե󥰤
	select(STDOUT); $| = 1;
	# ҥץץμ¹
	$exec_file = $HERE;
	$exec_file .= "tk-visips.tcl -display $display -mode $mode";
	$exec_file .= " -initfile $visipsrc";
	exec($exec_file);
	exit(0);
    }
    #-----------------------------------------------
    # ƥץ¦
    #-----------------------------------------------
    # פʥեϥɥĤ
    close(R1);
    close(W2);
    # Хåե󥰤
    select(W1); $| = 1;select(STDOUT);
    # ǰΤᤷФ餯Ԥ
#    sleep 2;
}
