/**********************************************************************
 
	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	<fcntl.h>
#include	"memory_debug.h"
#include	"utils.h"
#include	"netutils.h"
#include	"xlerror.h"
#include	"xl.h"
#include	"mp.h"

XL_SEXP * xl_Set();
XL_SEXP * xl_GetElement();
L_CHAR * gblisp_site;

void
init_Set(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"Set"),
		get_func_prim(xl_Set,FO_APPLICATIVE,0,3,4));
}


void
send_trigger(L_CHAR * filename)
{
L_CHAR * _filename;
int pp;
	_filename = ll_copy_str(filename,1446);
	pp = l_strlen(_filename)-1;
	for ( ; pp >= 0 && _filename[pp] != '.' ; pp -- );
	if ( pp < 0 )
		return;
	_filename[pp] = 0;
	if ( l_strcmp(&_filename[pp-4],l_string(std_cm,".crd")) )
		return;
	gb_MPTrigger(gblisp_top_env0,
		List(n_get_symbol("MPTrigger"),
			get_string(_filename),
			-1));
	d_f_ree(_filename);
}

XL_SEXP * 
get_user_ip_for_set(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * ip, * a;
	ip = get_user_ip(env);
	switch ( get_type(ip) ) {
	case XLT_ERROR:
		return ip;
	case XLT_PAIR:
		break;
	default:
		goto type_missmatch;
	}
	a = 0;
	for ( ; get_type(ip) ; ) {
		a = car(ip);
		ip = cdr(ip);
		if ( ip == 0 )
			break;
	}
	switch ( get_type(a) ) {
	case XLT_ERROR:
	case XLT_INTEGER:
		return a;
	default:
	type_missmatch:
		return get_error(
			s->h.file,
			s->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"Set"),
			n_get_string(
			"type missmatch of the return value of GetUserInfo"));
	}
}

XL_SEXP *
get_element(XL_SEXP * rec,char * tag)
{
XL_SEXP * ss, * data;

	ss = 	List(	get_symbol(l_string(std_cm,"GetElement")),
			rec,
			get_symbol(l_string(std_cm,tag)),
			-1);
	ss = xl_GetElement(0,ss);
	switch ( get_type(ss) ) {
	case XLT_ERROR:
		return ss;
	case XLT_NULL:
		goto param_error_src_dest;
	}
	data = get_el(ss,1);
	if  ( get_type(data) != XLT_STRING )
		goto type_missmatch;
	return data;
param_error_src_dest:
	return get_error(
		rec->h.file,
		rec->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"Set"),
		List(n_get_string(
			"invalid parameter / src dest map is required"),
			n_get_string(tag),
			-1));
type_missmatch:
	return get_error(
		rec->h.file,
		rec->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Set"),
		n_get_string("type missmatch in src dest map element"));
}

XL_SEXP *
marge_element(XL_SEXP * a,XL_SEXP * b,int * mod_flag)
{
XL_SEXP * c,* el,* b_el,* b_type;
XL_SEXP * type;
XL_SEXP * r;
unsigned int mod_old,mod_new;
XL_SEXP * md;
int md_check;

	r = 0;
	md_check = 0;
	for ( ; get_type(a) ; a = cdr(a) ) {
		el = car(a);
		if ( get_type(el) != XLT_PAIR ) {
			r = cons(el,r);
			continue;
		}
		type = car(el);
		if ( get_type(type) != XLT_SYMBOL ) {
			r = cons(el,r);
			continue;
		}
		c = b;
		b = 0;
		for ( ; get_type(c) ; c = cdr(c) ) {
			b_el = car(c);
			if ( get_type(b_el) != XLT_PAIR )
				continue;
			b_type = car(b_el);
			if ( get_type(b_type) != XLT_SYMBOL )
				continue;
			if ( l_strcmp(type->symbol.data,
					b_type->symbol.data) != 0 ) {
				b = cons(b_el,b);
				continue;
			}
			goto fit;
		}
		r = cons(el,r);
		continue;
	fit:
		if ( l_strcmp(type->symbol.data,l_string(std_cm,"mod"))
				== 0 ) {
			md = get_el(el,1);
			if ( get_type(md) != XLT_INTEGER )
				mod_old = 0;
			else	mod_old = md->integer.data;
			md = get_el(b_el,1);
			if ( get_type(md) != XLT_INTEGER )
				mod_new = 0;
			else	mod_new = md->integer.data;
			if ( get_type(get_el(el,2)) != XLT_INTEGER 
				|| mod_new > mod_old ) {
				r = cons(
					List(get_el(b_el,0),
						get_el(b_el,1),
						get_integer(
							get_xltime(),
							l_string(std_cm,"sec"))
							,
						-1),
					r);
				*mod_flag = 1;
			}
			else 	r = cons(el,r);
		}
		else {
			r = cons(b_el,r);
		}
		b = append(b,cdr(c));
	}
	c = 0;
	for ( ; b ; b = cdr(b) ) {
		b_el = car(b);
		if ( get_type(b_el) != XLT_PAIR )
			goto next;
			b_type = car(b_el);
		if ( get_type(b_type) != XLT_SYMBOL )
			goto next;
		if ( l_strcmp(b_type->symbol.data,
				l_string(std_cm,"mod")) )
			goto next;
		b_el = List(
			get_el(b_el,0),
			get_el(b_el,1),
			get_integer(
				get_xltime(),
				l_string(std_cm,"sec")),
			-1);
		*mod_flag = 1;
	next:
		c = cons(b_el,c);
	}
	for ( ; r ; r = cdr(r) )
		c = cons(car(r),c);
	return c;
}

XL_SEXP *
check_set_permission(
	XLISP_ENV * env,
	XL_SEXP * s,
	XL_GETFILE * gf,L_CHAR * src,L_CHAR * dest,L_CHAR * map,
	L_CHAR * filename)
{
URL u_src,u_dest,u_map;
URL * u_me;
XL_SEXP * ip, * a, *ret;
L_CHAR * db_res;
int len;
XL_SEXP * where, * port;
L_CHAR * _file;
int p1;
char buf[100];

	_file = ll_copy_str(filename,1445);
	for ( p1 = l_strlen(_file)-1 ; p1 >= 0 ; p1 -- )
		if ( _file[p1] == '.' )
			break;
	if ( p1 < 0 )
		er_panic("check_set_permission(1)");
	_file[p1] = 0;

	where = 0;
	get_url2(&u_src,src,1208);
	get_url2(&u_dest,dest,1209);
	get_url2(&u_map,map,1210);
	if ( u_src.proto == 0 || u_src.server == 0 ||
			u_src.db == 0 || u_src.resource == 0 )
		goto url_error;
	if ( l_strcmp(u_src.proto,l_string(std_cm,"xlp")) )
		goto url_error;
	if ( u_src.db[0] != '/' )
		goto url_error;
	if ( u_dest.proto == 0 || u_dest.server == 0 ||
			u_dest.db == 0 || u_dest.resource == 0 )
		goto url_error;
	if ( l_strcmp(u_dest.proto,l_string(std_cm,"xlp")) )
		goto url_error;
	if ( u_dest.db[0] != '/' )
		goto url_error;
	if ( u_map.proto == 0 || u_map.server == 0 ||
			u_map.db == 0 || u_map.resource == 0 )
		goto url_error;
	if ( l_strcmp(u_map.proto,l_string(std_cm,"xlp")) )
		goto url_error;
	if ( u_map.db[0] != '/' )
		goto url_error;
	if ( l_strcmp(gf->mode,l_string(std_cm,"src")) == 0 )
		u_me = &u_src;
	else 	u_me = &u_dest;
	if ( hostcmp(n_string(std_cm,u_me->server),getHA_v4(0),
			n_string(std_cm,gblisp_site),getHA_v4(0)) ) {
		where = get_string(gf->mode);
		goto url_permission;
	}
	port = eval(gblisp_top_env1,get_symbol(l_string(std_cm,"ServerPort")));
	switch ( get_type(port) ) {
	case XLT_ERROR:
		goto err;
	case XLT_INTEGER:
		break;
	default:
		goto type_missmatch;
	}
	if ( u_me->port != port->integer.data ) {
		where = get_string(gf->mode);
		goto url_permission;
	}
	db_res = d_alloc(((len=l_strlen(u_me->db))
				+l_strlen(u_me->resource)+2)
			*sizeof(L_CHAR),671);
	l_strcpy(db_res,u_me->db);
	l_strcpy(&db_res[len],u_me->resource);
	if ( l_strcmp(_file,db_res) ) {
		d_f_ree(db_res);
		goto url_error;
	}
	d_f_ree(db_res);
	a = get_user_ip_for_set(env,s);
	if ( get_type(a) == XLT_ERROR ) {
		ret = a;
		goto err;
	}
	if ( hostcmp(n_string(std_cm,u_map.server),getHA_v4(0),
			0,getHA_v4(a->integer.data)) ) {
		sprintf(buf,"map(%s %x)",n_string(std_cm,u_map.server),
			a->integer.data);
		where = n_get_string(buf);
		goto url_permission;
	}
	return 0;
url_error:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"Set"),
		n_get_string("invalid parameter in URL"));
	goto err;
url_permission:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_PERMISSION_DENIED,
		l_string(std_cm,"Set"),
		List(	n_get_string("permission denied"),
			where,
			-1));
	goto err;
get_user_type_missmatch:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Set"),
		n_get_string(
		"type missmatch of the return value of GetUserInfo"));
	goto err;
type_missmatch:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Set"),
		n_get_string(
		"ServerPort type missmatch"));
	goto err;
err:
	free_url(&u_src);
	free_url(&u_dest);
	free_url(&u_map);
	return ret;
}

XL_SEXP *
normalize_rec(L_CHAR * mode,XL_SEXP * rec)
{
XL_SEXP * r1,* r2, * ret, * sym, * u;
URL _u;
	r1 = 0;
	for ( ; get_type(rec) ; rec = cdr(rec) ) {
		if ( get_type(rec) != XLT_PAIR )
			break;
		r2 = car(rec);
		if ( get_type(r2) != XLT_PAIR ) {
			r1 = cons(r2,r1);
			continue;
		}
		sym = car(r2);
		if ( get_type(sym) != XLT_SYMBOL ) {
			r1 = cons(r2,r1);
			continue;
		}
		if ( l_strcmp(sym->symbol.data,mode) ) {
			r1 = cons(r2,r1);
			continue;
		}
		u = get_el(r2,1);
		if ( get_type(u) != XLT_STRING ) {
			r1 = cons(r2,r1);
			continue;
		}
		get_url2(&_u,u->string.data,1211);
		d_f_ree(_u.server);
		_u.server = ll_copy_str(gblisp_site,1444);
		r1 = cons(List(sym,
				get_string(get_url_str2(&_u)),
				-1),
			r1);
	}
	ret = 0;
	for ( ; get_type(r1) ; r1 = cdr(r1) )
		ret = cons(car(r1),ret);
	return ret;
}

XL_SEXP *
xl_Set_part(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a_env,XL_SYM_FIELD * sf,
	int cindex_time,int inner_call)
{
XL_SEXP * rec, * filename, * ret;
XL_SEXP * rec_type;
int option;
#define OP_REPLACE	1
#define OP_INSERT	2
#define OP_PART		3
#define OP_DELETE	4
XL_SEXP * load_data;
XL_SEXP * a,* b,* data_type;
L_CHAR * _filename;
L_CHAR * target[2];
XL_GETFILE * gf;
L_CHAR * fn;
int i;
XL_SEXP * lr;
L_CHAR * lock_path, * access_path;
XL_SEXP * src,* dest, * map;
L_CHAR * _src, * _dest, * _map;
int _src_ret,_dest_ret,_map_ret;
int replace_flag;
STREAM * st;
MP_WORK mpw;
unsigned int interval;
XL_SEXP * _interval;
int trigger;
int mf,mf2,mf3;
int ll;

int db_f;



	mf3 = 0;
	trigger = 0;
	if ( list_length(s) == 4 ) {
		_interval = get_el(s,3);
		if ( get_type(_interval) == XLT_INTEGER )
			interval = _interval->integer.data;
		else	goto type_missmatch;
	}
	else	interval = MAPPING_INTERVAL_UNIT;

	get_mp_work(&mpw,MP_UNCACHE);
	target[0] = target[1] = 0;
	filename = get_el(s,1);
	if ( get_type(filename) != XLT_STRING )
		goto type_missmatch;
	_filename = filename->string.data;
	rec = get_el(s,2);
	if ( get_type(rec) != XLT_PAIR )
		goto type_missmatch;
	rec_type = car(rec);
	switch ( get_type(rec_type) ) {
	case XLT_ERROR:
		return rec_type;
	case XLT_SYMBOL:
		break;
	default:
		goto param_error;
	}
	src = get_element(rec,"src");
	if ( get_type(src) == XLT_ERROR )
		return src;
	dest = get_element(rec,"dest");
	if ( get_type(dest) == XLT_ERROR )
		return dest;
	map = get_element(rec,"map");
	if ( get_type(map) == XLT_ERROR )
		return map;

	option = 1;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"option")) == 0 ) {
			if ( l_strcmp(sf->data,
				l_string(std_cm,"replace")) == 0 )
				option = OP_REPLACE;
			else if ( l_strcmp(sf->data,
				l_string(std_cm,"insert")) == 0 )
				option = OP_INSERT;
			else if ( l_strcmp(sf->data,
				l_string(std_cm,"part")) == 0 )
				option = OP_PART;
			else if ( l_strcmp(sf->data,
				l_string(std_cm,"delete")) == 0 )
				option = OP_DELETE;
		}
	}
	target[0] = target[1] = 0;
	fn = nl_copy_str(std_cm,"Set");
	ret = get_path(target,&gf,_filename,s,fn);
	if ( get_type(ret) == XLT_ERROR )
		goto end;
	d_f_ree(fn);
	if ( env ) {
		ret = check_set_permission(
			env,s,gf,
			src->string.data,
			dest->string.data,
			map->string.data,
			_filename);
		if ( get_type(ret) == XLT_ERROR )
			goto end;
	}
	rec = normalize_rec(gf->mode,rec);
	if ( env )
		rec = cons(car(rec),
			cons(List(n_get_symbol("tm"),
				get_integer(get_xltime()+interval,
					l_string(std_cm,"sec")),
				-1),
				cdr(rec)));
	ll = l_strlen(src->string.data);
	if ( l_strcmp(&src->string.data[ll-4],l_string(std_cm,".crd")) ) {
		ll = l_strlen(_filename);
		if ( l_strcmp(&_filename[ll-8],l_string(std_cm,".crd.chi"))
					 == 0 )
			mf2 = 1;
		else	mf2 = 0;
	}
	else	mf2 = 0;

	for ( i = 0 ; i < 2 ; i ++ ) {
		if ( target[i] == 0 )
			break;
		lock_path = 0;
		switch ( gf->flags & XLGFM_LOCK ) {
		case XLGF_FULL_PATH:
			lr = connect_lock(s,lock_path = target[i],"write");
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		case XLGF_URL_PATH:
			lr = connect_lock(s,lock_path = _filename,"write");
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		}
		access_path = target[i];
		ret = load_file(env,s,1,target[i],0,0,0,0,0);
		if ( get_type(ret) != XLT_ERROR )
			break;
		if ( lock_path )
			connect_unlock(s,lr->integer.data,lock_path);
		if ( ret->err.code != XLE_PROTO_OPEN_FILE )
			goto end;
	}
	if ( i == 2 || target[i] == 0 )
		goto end;
	load_data = ret;
	ret = 0;
	replace_flag = 0;


	for ( a = load_data ; get_type(a) ; a = cdr(a) ) {
		b = car(a);
		if ( replace_flag ) {
			ret = cons(b,ret);
			continue;
		}
		switch ( get_type(b) ) {
		case XLT_ERROR:
			ret = b;
			goto close_end;
		case XLT_PAIR:
			break;
		default:
			ret = cons(b,ret);
			continue;
		}
		data_type = car(b);
		switch ( get_type(data_type) ) {
		case XLT_ERROR:
			ret = data_type;
			goto close_end;
		case XLT_SYMBOL:
			break;
		default:
			ret = cons(b,ret);
			continue;
		}
		if ( l_strcmp(data_type->symbol.data,
				l_string(std_cm,"cindex")) == 0 ) {
			mf3 = 1;
			if ( cindex_time == 0 )
				ret = cons(b,ret);
			continue;
		}
		if ( l_strcmp(data_type->symbol.data,
				rec_type->symbol.data) != 0 ) {
			ret = cons(b,ret);
			continue;
		}
		get_field(b,
			l_string(std_cm,"src"),"s",&_src,&_src_ret,
			l_string(std_cm,"dest"),"s",&_dest,&_dest_ret,
			l_string(std_cm,"map"),"s",&_map,&_map_ret,
			0);
		if ( _src_ret || _dest_ret || _map_ret ) {
			ret = cons(b,ret);
			continue;
		}
		if ( l_strcmp(src->string.data,_src) != 0 ) {
			ret = cons(b,ret);
			continue;
		}
		if ( l_strcmp(dest->string.data,_dest) != 0 ) {
			ret = cons(b,ret);
			continue;
		}
		if ( l_strcmp(map->string.data,_map) != 0 ) {
			ret = cons(b,ret);
			continue;
		}
		switch ( option ) {
		case OP_REPLACE:
			ret = cons(rec,ret);
			break;
		case OP_INSERT:
			ret = cons(rec,ret);
			break;
		case OP_PART:
			ret = cons(marge_element(b,rec,&mf),ret);
			break;
		case OP_DELETE:
			break;
		}
		replace_flag = 1;
		trigger = 1;
	}
	if ( (option == OP_INSERT ||
			option == OP_PART) &&
			replace_flag == 0 ) {

		ret = cons(rec,ret);
		trigger = 1;
	}
	if ( option == OP_REPLACE && replace_flag == 0 ) {
		ret = List(n_get_string("noupdate"),
				get_integer(mpw.total_map_references,0),
				-1);
		goto close_end;
	}

	a = 0;
	for ( ; ret ; ret = cdr(ret) )
		a = cons(car(ret),a);

	if ( cindex_time ) {
		a = cons(
			List(n_get_symbol("cindex"),
				get_integer(cindex_time,
					l_string(std_cm,"sec")),
				-1),
			a);
	}
	st = s_open_file(n_string(std_cm,access_path),
		O_CREAT|O_TRUNC|O_RDWR,0644);
	print_sexp(st,a,PF_MULTI_ROOT|PF_LISP);
	s_close(st);
	ret = List(n_get_string("update"),
			get_integer(mpw.total_map_references,0),
			-1);
close_end:
	if ( lock_path )
		connect_unlock(s,lr->integer.data,lock_path);
end:
	if ( target[0] )
		d_f_ree(target[0]);
	if ( target[1] )
		d_f_ree(target[1]);
	if ( inner_call == 0 ) {
		if ( trigger )
			send_trigger(_filename);
/*
ss_printf("MF %i %i %ls %ls %ls\n",mf,mf2,_filename,src->string.data,dest->string.data);
*/
		if ( mf3 == 0 && mf2 )
			send_cindex(_filename);
		else if ( mf && mf2 )
			send_cindex(_filename);
	}
	return ret;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Set"),
		0);
param_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"Set"),
		n_get_string("invalid parameter"));
}



XL_SEXP *
xl_Set_full(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * rec, * filename, * ret;
XL_SEXP * rec_type;
int option;
#define OP_REPLACE	1
#define OP_INSERT	2
#define OP_PART		3
#define OP_DELETE	4
XL_SEXP * load_data;
XL_SEXP * a,* b,* data_type;
L_CHAR * _filename;
L_CHAR * target[2];
XL_GETFILE * gf;
L_CHAR * fn;
int i;
XL_SEXP * lr;
L_CHAR * lock_path, * access_path;
STREAM * st;
MP_WORK mpw;

	target[0] = target[1] = 0;
	filename = get_el(s,1);
	if ( get_type(filename) != XLT_STRING )
		goto type_missmatch;
	_filename = filename->string.data;
	rec = get_el(s,2);

	target[0] = target[1] = 0;
	fn = nl_copy_str(std_cm,"Set");
	ret = get_path(target,&gf,_filename,s,fn);
	if ( get_type(ret) == XLT_ERROR )
		goto end;
	d_f_ree(fn);

	a = get_user_ip_for_set(env,s);
	if ( get_type(a) == XLT_ERROR )
		goto end;
	if ( hostcmp(0,getHA_v4(a->integer.data),
			n_string(std_cm,gblisp_site),getHA_v4(0)) )
		goto permission_error;

	for ( i = 0 ; i < 2 ; i ++ ) {
		lock_path = 0;
		switch ( gf->flags & XLGFM_LOCK ) {
		case XLGF_FULL_PATH:
			lr = connect_lock(s,lock_path = target[i],"write");
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		case XLGF_URL_PATH:
			lr = connect_lock(s,lock_path = _filename,"write");
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		}
		access_path = target[i];
		st = s_open_file(n_string(std_cm,access_path),
			O_TRUNC|O_RDWR,0644);
		if ( st )
			break;
		if ( lock_path )
			connect_unlock(s,lr->integer.data,lock_path);
		if ( ret->err.code != XLE_PROTO_OPEN_FILE )
			goto end;
	}
	if ( i == 2 )
		goto end;

	print_sexp(st,rec,PF_MULTI_ROOT|PF_LISP);
	s_close(st);
	get_mp_work(&mpw,MP_UNCACHE);
	ret = List(n_get_string("update"),
			get_integer(mpw.total_map_references,0),
			-1);
close_end:
	if ( lock_path )
		connect_unlock(s,lr->integer.data,lock_path);
end:
	if ( target[0] )
		d_f_ree(target[0]);
	if ( target[1] )
		d_f_ree(target[1]);
	return ret;
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Set"),
		0);
param_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"Set"),
		n_get_string("invalid parameter"));
permission_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_PERMISSION_DENIED,
		l_string(std_cm,"Set"),
		n_get_string("permission denied"));
}


XL_SEXP *
xl_Set(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a_env,XL_SYM_FIELD * sf)
{
XL_GETFILE * gf;
int ptr;
XL_SEXP * filename;
extern L_CHAR * agent_name;
XL_SEXP * ret;
	filename = get_el(s,1);
	ptr = l_strlen(filename->string.data)-1;
	for ( ; ptr >= 0 ; ptr -- ) {
		if ( filename->string.data[ptr] == '.' )
			break;
		if ( filename->string.data[ptr] == '/' )
			goto format_error;
	}
	if ( ptr < 0 )
		goto format_error;
	gf = search_getfile(&filename->string.data[ptr],agent_name);
	if ( gf == 0 )
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_UNDEF_RESOURCE,
			l_string(std_cm,"Set"),
			n_get_string("undefined prefix"));
	if ( l_strcmp(gf->mode,l_string(std_cm,"file")) == 0 )
		ret = xl_Set_full(env,s);
	else	ret = xl_Set_part(env,s,a_env,sf,0,0);
	gb_MPTrigger(gblisp_top_env0,
		List(n_get_symbol("MPTrigger"),
			filename,
			-1));
	return ret;
format_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"Set"),
		n_get_string("invalid path name"));
}
