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

XL_SEXP * xl_Get();
extern L_CHAR * database_path,* agent_name;
XL_SEXP * load_file();

typedef struct load_file_t {
	XL_SEXP * 	s;
	int		id;
	L_CHAR * 	path;
} LOAD_FILE_T;


void
init_Get(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"Get"),
		get_func_prim(xl_Get,FO_APPLICATIVE,0,2,2));
}

void
lf_close_function(int type,LOAD_FILE_T * lft)
{
	switch ( type ) {
	case CF_CLOSE:
		connect_unlock(lft->s,lft->id,lft->path);
		d_f_ree(lft->path);
		d_f_ree(lft);
		break;
	case CF_GC:
		gc_gb_sexp(lft->s);
		break;
	}
}

LOAD_FILE_T * 
new_lft(XL_SEXP * s,int id,L_CHAR * path)
{
LOAD_FILE_T * lft;
	lft = d_alloc(sizeof(*lft),671);
	lft->s = s;
	lft->id = id;
	lft->path = ll_copy_str(path,1474);
	return lft;
}


XL_SEXP *
get_op(XLISP_ENV * env,XL_SEXP * ss,L_CHAR * filename)
{
XL_SEXP * ret;
int i;
XL_SEXP * lr;
LOAD_FILE_T * lft;
void (*lf_func)();
L_CHAR * target[2];
L_CHAR * fn;
XL_GETFILE * gf;

int tim;
	fn = nl_copy_str(std_cm,"Get");
	target[0] = target[1] = 0;
	ret = get_path(target,&gf,filename,ss,fn);
	if ( get_type(ret) == XLT_ERROR )
		goto end;
	d_f_ree(fn);

	for ( i = 0 ; i < 2 ; i ++ ) {
		if ( target[i] == 0 )
			break;

		lft = 0;
		lf_func = 0;

		switch ( gf->flags & XLGFM_LOCK ) {
		case XLGF_FULL_PATH:
			lr = connect_lock(ss,target[i],"read");
			lft = new_lft(ss,lr->integer.data,target[i]);
			lf_func = lf_close_function;
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		case XLGF_URL_PATH:
			lr = connect_lock(ss,
				filename,"read");
			lft = new_lft(ss,lr->integer.data,
				filename);
			lf_func = lf_close_function;
			if ( get_type(lr) == XLT_ERROR ) {
				ret = lr;
				goto end;
			}
			break;
		}


		if ( l_strcmp(gf->mode,l_string(std_cm,"xl")) == 0 )
			ret = load_file(env,ss,1,target[i],0,0,0,
				lf_func,
				lft);
		else if ( l_strcmp(gf->mode,l_string(std_cm,"raw")) == 0 )
			ret = load_file(env,ss,0,target[i],0,0,0,
				lf_func,
				lft);
		else {
			ret = get_error(
				ss->h.file,
				ss->h.line,
				XLE_PROTO_UNSUPPORT_MODE,
				l_string(std_cm,"Get"),
				n_get_string("unsupport Get mode"));
			i = 2;
		}
		if ( get_type(ret) == XLT_ERROR && lft )
			lf_close_function(CF_CLOSE,lft);

		if ( get_type(ret) != XLT_ERROR )
			i = 2;
		else if ( ret->err.code != XLE_PROTO_OPEN_FILE )
				i = 2;
	}
end:
	if ( target[0] )
		d_f_ree(target[0]);
	if ( target[1] )
		d_f_ree(target[1]);
	return ret;
type_missmatch:
	return get_error(
		ss->h.file,
		ss->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Get"),
		n_get_string("type missmatch"));
}


XL_SEXP *
xl_Get(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * filename;
XL_SEXP * ret;
int i;
XL_SEXP * lr;
LOAD_FILE_T * lft;
void (*lf_func)();
L_CHAR * target[2];
L_CHAR * fn;
XL_GETFILE * gf;
	filename = get_el(s,1);
	if ( get_type(filename) != XLT_STRING )
		goto type_missmatch;
	return get_op(env,s,filename->string.data);

type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Get"),
		n_get_string("type missmatch"));
}



