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

void gc_gb_sexp();
XL_SEXP * xl_pmd_query();

#define OPT_LONG	0x00000001

void
init_pmd_query(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"pmd-query"),
		get_func_prim(xl_pmd_query,FO_APPLICATIVE,0,6,6));
}

XL_SEXP *
format_bib(BIB_LIST * bl)
{
XL_SEXP * ret;
	ret= 0;
	gc_push(0,0,"format_bib");
	for ( ; bl ; bl = bl->next ) {
		gc_push(ret,gc_gb_sexp,"format_bib");
		ret = cons(
			List(
				get_string(bl->namespace),
				get_integer(bl->inherit,0),
				get_string(bl->qualifier),
				get_string(bl->type),
				get_string(bl->data),
				-1),
			ret);
		gc_pop(ret,gc_gb_sexp);
	}
	gc_pop(ret,gc_gb_sexp);
	return cons(n_get_symbol("bib"),ret);
}

XL_SEXP *
format_pmd_temp(int opt,PMD_TEMP * t)
{
XL_SEXP * ret; 
XL_SEXP * lng;

	gc_push(0,0,"format_pmd_temp");
	ret = List(
		get_string(t->crd),
		get_string(t->target),
		-1);

	if ( opt & OPT_LONG ) {

		lng = List(
			List(n_get_symbol("category"),
				get_integer(t->category,0),
				-1),
			List(n_get_symbol("mr"),
				List(
				List(	get_floating(t->minrect.tl.x,
						l_string(std_cm,"m")),
					get_floating(t->minrect.tl.y,
						l_string(std_cm,"m")),
					-1),
				List(	get_floating(t->minrect.br.x,
						l_string(std_cm,"m")),
					get_floating(t->minrect.br.y,
						l_string(std_cm,"m")),
					-1),
				-1),
				-1),
			List(n_get_symbol("v"),
				get_floating(t->resolution,
					l_string(std_cm,"dot/m")),
				-1),
			List(n_get_symbol("timeout"),
				get_integer(t->timeout,
					l_string(std_cm,"sec")),
				-1),
			format_bib(t->md_list),
			-1);
		ret = append(ret,lng);
	}

	gc_pop(ret,gc_gb_sexp);
	return ret;
}

XL_SEXP *
format_pmd_temp_list(int opt,PMD_TEMP_LIST * tl)
{
XL_SEXP * ret;

	gc_push(0,0,"format_pmd_temp_list");
	ret = 0;
	for ( ; tl ; tl = tl->next ) {
		gc_push(ret,gc_gb_sexp,"fomrat_pmd_temp_list");
		ret = cons(format_pmd_temp(opt,tl->temp),ret);
		gc_pop(ret,gc_gb_sexp);
	}
	gc_pop(ret,gc_gb_sexp);
	return ret;
}

int tt_flag;

int
check_filter_bib(XL_SEXP ** retp,BIB_LIST * bl,XL_SEXP * filter,
	L_CHAR * ns,
	int inh,
	L_CHAR * q,
	L_CHAR * type,
	L_CHAR * data,
	L_CHAR * cond)
{
XL_SEXP * ret;

	if ( ns && l_strcmp(ns,bl->namespace) )
		return 0;
	if ( inh != -1 && inh != bl->inherit )
		return 0;
	if ( q && l_strcmp(q,bl->qualifier) )
		return 0;
	if ( type && l_strcmp(type,bl->type) )
		return 0;
	if ( data == 0 )
		return 1;
	if ( cond ) {
		if ( l_strcmp(cond,l_string(std_cm,"part")) == 0 )
			return cmp_part(bl->data,data);
		if ( l_strcmp(cond,l_string(std_cm,"full")) == 0 )
			goto full;
		if ( l_strcmp(cond,l_string(std_cm,"under.than")) == 0 ) {
			if ( check_filter_cmp(&ret,bl->type,bl->data,
					type,data,filter) < 0 ) {
				if ( get_type(ret) == XLT_ERROR ) {
					*retp = ret;
					return -1;
				}
				return 1;
			}
			if ( get_type(ret) == XLT_ERROR ) {
				*retp = ret;
				return -1;
			}
			return 0;
		}
		if ( l_strcmp(cond,l_string(std_cm,"over.than")) == 0 ) {
			if ( check_filter_cmp(&ret,bl->type,bl->data,
					type,data,filter) > 0 ) {
				if ( get_type(ret) == XLT_ERROR ) {
					*retp = ret;
					return -1;
				}
				return 1;
			}
			if ( get_type(ret) == XLT_ERROR ) {
				*retp = ret;
				return -1;
			}
			return 0;
		}
		if ( l_strcmp(cond,l_string(std_cm,"under.equ.than")) == 0 ) {
			if ( check_filter_cmp(&ret,bl->type,bl->data,
					type,data,filter) <= 0 ) {
				if ( get_type(ret) == XLT_ERROR ) {
					*retp = ret;
					return -1;
				}
				return 1;
			}
			if ( get_type(ret) == XLT_ERROR ) {
				*retp = ret;
				return -1;
			}
			return 0;
		}
		if ( l_strcmp(cond,l_string(std_cm,"over.equ.than")) == 0 ) {
			if ( check_filter_cmp(&ret,bl->type,bl->data,
					type,data,filter) >= 0 ) {
				if ( get_type(ret) == XLT_ERROR ) {
					*retp = ret;
					return -1;
				}
				return 1;
			}
			if ( get_type(ret) == XLT_ERROR ) {
				*retp = ret;
				return -1;
			}
			return 0;
		}
		if ( l_strcmp(cond,l_string(std_cm,"boundary")) == 0 ) {
			if ( check_filter_bound(&ret,bl->type,bl->data,
					type,data,filter) == 0 ) {
				if ( get_type(ret) == XLT_ERROR ) {
					*retp = ret;
					return -1;
				}
				return 1;
			}
			if ( get_type(ret) == XLT_ERROR ) {
				*retp = ret;
				return -1;
			}
			return 0;
		}
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (qualifier invalid attr."));
		return -1;
	}
	else {
	full:
		if ( l_strcmp(data,bl->data) )
			return 0;
		return 1;
	}
}

int
check_filter(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter);

int
check_filter_qualifier(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
XL_SEXP * cmd;
XL_SEXP * ns;
XL_SEXP * inh;
XL_SEXP * qualifier;
XL_SEXP * type;
XL_SEXP * data;
L_CHAR * cond;
L_CHAR * _ns;
L_CHAR * _qualifier;
L_CHAR * _type;
L_CHAR * _data;
BIB_LIST * bl;
int _inh;

	if ( list_length(filter) != 6 ) {
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (qualifier function length)"));
		return -1;
	}
	cmd = get_el(filter,0);
	ns = get_el(filter,1);
	inh = get_el(filter,2);
	qualifier = get_el(filter,3);
	type = get_el(filter,4);
	data = get_el(filter,5);
	switch ( get_type(ns) ) {
	case XLT_ERROR:
		*retp = ns;
		return -1;
	case XLT_NULL:
		_ns = 0;
		break;
	case XLT_STRING:
		_ns = ns->string.data;
		break;
	default:
		goto type_missmatch;
	}
	switch ( get_type(inh) ) {
	case XLT_ERROR:
		*retp = inh;
		return -1;
	case XLT_NULL:
		_inh = -1;
		break;
	case XLT_INTEGER:
		_inh = inh->integer.data;
		break;
	default:
		goto type_missmatch;
	}
	switch ( get_type(qualifier) ) {
	case XLT_ERROR:
		*retp = qualifier;
		return -1;
	case XLT_NULL:
		_qualifier = 0;
		break;
	case XLT_STRING:
		_qualifier = qualifier->string.data;
		break;
	default:
		goto type_missmatch;
	}
	switch ( get_type(type) ) {
	case XLT_ERROR:
		*retp = type;
		return -1;
	case XLT_NULL:
		_type = 0;
		break;
	case XLT_STRING:
		_type = type->string.data;
		break;
	default:
		goto type_missmatch;
	}
	switch ( get_type(data) ) {
	case XLT_ERROR:
		*retp = data;
		return -1;
	case XLT_NULL:
		_data = 0;
		break;
	case XLT_STRING:
		_data = data->string.data;
		break;
	default:
		goto type_missmatch;
	}
	cond = get_sf_attribute(cmd->symbol.field,l_string(std_cm,"cond"));
	for ( bl = tl->md_list ; bl ; bl = bl->next ) {
		switch ( check_filter_bib(retp,bl,filter,
			_ns,_inh,_qualifier,_type,_data,cond) ) {
		case 1:
			return 1;
		case 0:
			break;
		default:
			return -1;
		}
	}
	return 0;
type_missmatch:
	*retp = get_error(
		filter->h.file,
		filter->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (qualifier param type missmatch)"));
	return -1;
}

int
check_filter_AND(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
XL_SEXP * cmd;
XL_SEXP * s1, * s2;
int result,r;
	if ( list_length(filter) < 3 ) {
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (AND function length)"));
		return -1;
	}
	s1 = cdr(filter);
	result = 1;
	for ( ; get_type(s1) == XLT_PAIR ; s1 = cdr(s1) ) {
		r = check_filter(retp,tl,car(s1));
		switch ( r ) {
		case 1:
			break;
		case 0:
			result = 0;
			break;
		default:
			return -1;
		}
	}
	return result;
}

int
check_filter_OR(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
XL_SEXP * cmd;
XL_SEXP * s1, * s2;
int result,r;
	if ( list_length(filter) < 3 ) {
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (OR function length)"));
		return -1;
	}
	s1 = cdr(filter);
	result = 0;
	for ( ; get_type(s1) == XLT_PAIR ; s1 = cdr(s1) ) {
		r = check_filter(retp,tl,car(s1));
		switch ( r ) {
		case 1:
			result = 1;
			break;
		case 0:
			break;
		default:
			return -1;
		}
	}
	return result;
}

int
check_filter_NOT(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
XL_SEXP * cmd;
XL_SEXP * s1, * s2;
int r;
	if ( list_length(filter) != 2 ) {
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (NOT function length)"));
		return -1;
	}
	r = check_filter(retp,tl,get_el(filter,1));
	switch ( r ) {
	case 1:
		return 0;
	case 0:
		return 1;
	default:
		return -1;
	}
	return 0;
}

int
check_filter_URL(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
L_CHAR * cond;
XL_SEXP * cmd;
XL_SEXP * url;
	if ( list_length(filter) != 2 ) {
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (NOT function length)"));
		return -1;
	}
	cmd = get_el(filter,0);
	url = get_el(filter,1);
	cond = get_sf_attribute(cmd->symbol.field,l_string(std_cm,"cond"));
	switch ( get_type(url) ) {
	case XLT_ERROR:
		*retp = url;
		return -1;
	case XLT_STRING:
		break;
	default:
		goto type_missmatch;
	}
	if ( cond == 0 )
		goto full;
	if ( l_strcmp(cond,l_string(std_cm,"part")) == 0 )
		return cmp_part(tl->target,url->string.data);
	if ( l_strcmp(cond,l_string(std_cm,"full")) == 0 )
		goto full;
	if ( l_strcmp(cond,l_string(std_cm,"crd.part")) == 0 )
		return cmp_part(tl->crd,url->string.data);
	if ( l_strcmp(cond,l_string(std_cm,"crd.full")) == 0 ) {
		if ( l_strcmp(tl->crd,url->string.data) )
			return 0;
		return 1;
	}
full:
	if ( l_strcmp(tl->target,url->string.data) )
		return 0;
	return 1;
type_missmatch:
	*retp = get_error(
		filter->h.file,
		filter->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"pmd-query"),
n_get_string("type missmatch in filter command (qualifier param type missmatch)"));
	return -1;
}

int
check_filter_pair(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
XL_SEXP * cmd;
	cmd = car(filter);
	if ( get_type(cmd) != XLT_SYMBOL ) {
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
	n_get_string("type missmatch in filter command (no symbol cmd)"));
		return -1;
	}
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"AND")) == 0 )
		return check_filter_AND(retp,tl,filter);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"OR")) == 0 )
		return check_filter_OR(retp,tl,filter);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"NOT")) == 0 )
		return check_filter_NOT(retp,tl,filter);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"URL")) == 0 )
		return check_filter_URL(retp,tl,filter);
	if ( l_strcmp(cmd->symbol.data,l_string(std_cm,"qualifier")) == 0 )
		return check_filter_qualifier(retp,tl,filter);
	*retp = get_error(
		filter->h.file,
		filter->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"pmd-query"),
	n_get_string("type missmatch in filter command (undefined cmd)"));
	return -1;
}

int
check_filter(XL_SEXP ** retp,PMD_TEMP * tl,XL_SEXP * filter)
{
int ret;
	switch ( get_type(filter) ) {
	case XLT_INTEGER:
		return filter->integer.data;
	case XLT_PAIR:
		return  check_filter_pair(retp,tl,filter);
	case XLT_NULL:
		return 0;
	default:
		*retp = get_error(
			filter->h.file,
			filter->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"pmd-query"),
	n_get_string("type missmatch in filter command (filter type)"));
		return -1;
	}
}

XL_SEXP *
filter_db(PMD_TEMP_LIST ** tlp,XL_SEXP * filter)
{
PMD_TEMP_LIST * tl1;
XL_SEXP * ret;
	for ( ; *tlp ; ) {
		switch ( check_filter(&ret,(*tlp)->temp,filter) ) {
		case 1:
			tlp = &(*tlp)->next;
			break;
		case 0:
			tl1 = *tlp;
			*tlp = tl1->next;
			tl1->next = 0;
			free_pmd_temp_list(tl1);
			break;
		default:
			return ret;
		}
	}
	return 0;
}

XL_SEXP *
xl_pmd_query(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * db;
PMD_WORK w;
REAL1 _reso_min,_reso_max;
PMD_TEMP_LIST * tl;
GB_RECT _rect;
XL_SEXP * reso_min,* reso_max;
XL_SEXP * rect;
L_CHAR * format;
int opt;
int er;
XL_SEXP * ret;
XL_SEXP * filter;
L_CHAR * unit,* system;

	opt = 0;
	format = get_sf_attribute(sf,l_string(std_cm,"format"));
	if ( format ) {
		if ( l_strcmp(format,l_string(std_cm,"long")) == 0 )
			opt |= OPT_LONG;
	}
	db = get_el(s,1);
	if ( get_type(db) != XLT_STRING )
		goto type_missmatch;
	rect = get_el(s,2);
	if ( get_minrect(0,&_rect,rect) < 0 )
		goto type_missmatch;

	reso_min = get_el(s,3);
	switch ( get_type(reso_min) ) {
	case XLT_INTEGER:
		_reso_min = reso_min->integer.data;
		break;
	case XLT_FLOAT:
		_reso_min = reso_min->floating.data;
		break;
	default:
		goto type_missmatch;
	}
	reso_max = get_el(s,4);
	switch ( get_type(reso_max) ) {
	case XLT_INTEGER:
		_reso_max = reso_max->integer.data;
		break;
	case XLT_FLOAT:
		_reso_max = reso_max->floating.data;
		break;
	default:
		goto type_missmatch;
	}
	filter = get_el(s,5);

	open_db(&w,db->string.data,0,O_RDONLY);
	if ( w.err < 0 ) {
		close_db(&w);
		return 0;
	}

	tl = query_db(&w,&_rect,_reso_min,_reso_max);

	close_db(&w);

	ret = filter_db(&tl,filter);

	if ( get_type(ret) == XLT_ERROR )
		return ret;
	ret = format_pmd_temp_list(opt,tl);
	free_pmd_temp_list(tl);
	return ret;

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


