/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	This program is distributed in the hope that it will be 
	useful, but WITHOUT ANY WARRANTY; without even the 
	implied warranty of MERCHANTABILITY or FITNESS FOR A 
	PARTICULAR PURPOSE.

**********************************************************************/


#include	"memory_debug.h"
#include	"xlerror.h"
#include	"xl.h"
#include	"utils.h"

XL_SEXP *
connect_lock(XL_SEXP * s,L_CHAR * dir,char * type)
{
int id;
XL_SEXP * port;
XL_SEXP * hostname;
XL_SEXP * ret;
char * cmd;
L_CHAR * l_cmd;
XL_INTERPRETER * xli;
int retry_cnt;

	port = eval(gblisp_top_env1,
		get_symbol(l_string(std_cm,"LockPort")));
	switch ( get_type(port) ) {
	case XLT_ERROR:
		return port;
	case XLT_INTEGER:
		break;
	default:
		return get_error(
			s->h.file,
			s->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"lock operation"),
			n_get_string("LockPort type missmatich"));
	}
	hostname = eval(gblisp_top_env1,
		get_symbol(l_string(std_cm,"LockHostName")));
	switch ( get_type(hostname) ) {
	case XLT_ERROR:
		return hostname;
	case XLT_STRING:
		break;
	default:
		return get_error(
			s->h.file,
			s->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"lock operation"),
			n_get_string("LockHostName type missmatich"));
	}
	retry_cnt = 3;
retry:
	xli = new_xl_interpreter();
	xli->a_type = XLA_CONNECT;
	xli->env = gblisp_top_env1;
	xli->environment = 0;
	xli->port = port->integer.data;
	xli->hostname = ll_copy_str(hostname->string.data,1487);
	id = setup_i(xli);
	if ( id < 0 ) {
		retry_cnt --;
		if ( retry_cnt > 0 ) {
			sleep_sec(5);
			goto retry;
		}
		goto access_error;
	}
	cmd = d_alloc(1000,670);
	sprintf(cmd,"<Lock type=\"%s\"> %s </Lock>",
		type,n_string(std_cm,dir));
	l_cmd = nl_copy_str(std_cm,cmd);
	d_f_ree(cmd);
	ret = remote_query(id,gblisp_top_env1,l_cmd,0);
	d_f_ree(l_cmd);
	if ( get_type(ret) == XLT_ERROR ) {
		close_interpreter(id);
		return ret;
	}
	return get_integer(id,0);
	
access_error:
	if ( s == 0 )
		return 0;
	return get_error(
		s->h.file,
		s->h.line,
		 XLE_PROTO_ACCESS_STREAM,
		l_string(std_cm,"lock operation"),
		n_get_string("cannot access the lock server"));
}

void
connect_unlock(XL_SEXP * s,int id,L_CHAR * dir)
{
char * cmd;
L_CHAR * l_cmd;
XL_SEXP * ret;
	gc_push(0,0,"connect_unlock"); 
	cmd = d_alloc(1000,670);
	sprintf(cmd,"<Unlock> %s </Unlock>",
		n_string(std_cm,dir));
	l_cmd = nl_copy_str(std_cm,cmd);
	d_f_ree(cmd);
	ret = remote_query(id,gblisp_top_env1,l_cmd,0);
	get_type(ret);
	d_f_ree(l_cmd);
	close_interpreter(id);
	gc_pop(0,0);
}
