/* Dbadmin Server - DMS - dec 99 - by Patrice FAVRE */

struct Cli=[Id:CLIENT, Db:SqlDB, Table:S, LstCols:[[S r1] r1], Cols:S, Values:S, Set:S] mkCli;;
typeof LstCli=[Cli r1];;
var valnil="!!NIL!!";;
defcom CSqlErr=SqlErr S I S I;;
defcom CRetConnect=RetConnect I;;
defcom CRetGetTables=RetGetTables S;;
defcom CRetGetCols=RetGetCols S;;
defcom CRetGetRow=RetGetRow S;;
defcom CRetGetCount=RetGetCount S S;;
defcom CNoData=NoData;;
defcom CRetGetRows=RetGetRows S;;
defcom CRetDone=RetDone;;


/*-----------------------*/
fun conclst(p,q)=
	if p==nil then q
	else (hd p)::conclst (tl p) q
;;

/*-----------------------*/
fun iscli(cli,id)= cli.Id==id;;

/*-----------------------*/
fun filtcli(clid)=
	search_in_list LstCli @iscli clid
;;

/*-----------------------*/
fun DisconnectDB(db)=
	SqlDestroy db
;;

/*-----------------------*/
fun __Connect(nom,login,passw)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			DisconnectDB curcli.Db;
			set curcli.Db=SqlCreate _channel nom login if passw==nil then "" else passw;
			if curcli.Db!=nil then (
				_DMSsend this DMSsender CRetConnect [1];
				_DMSevent this DMSsender "connected" nil nil
			)
			else
				_DMSsend this DMSsender CRetConnect [0]
		)
		else nil
;;

/*-----------------------*/
fun clidestroyed(cli)=
	let search_in_list LstCli @iscli cli -> curcli in (
		DisconnectDB curcli.Db;
		set LstCli=remove_from_list LstCli curcli;
		_DMSevent this cli "destroyed" nil nil
	)
;;

/*-----------------------*/
fun action(from,cli,act,param,rep)=
	if !strcmp act "start" then
		if (_DMScreateClientDMI this cli nil)==1 then (
			set LstCli=(mkCli [cli nil nil nil nil nil nil])::LstCli;
			nil
		)
		else nil
	else
	if !strcmp act "destroy" then (
		_DMSdelClientDMI this cli;
		clidestroyed cli
	)
	else nil
;;

/*-----------------------*/
fun closedb(cli,u)=
	DisconnectDB cli.Db
;;

/*-----------------------*/
fun beforeclose()=
	apply_on_list LstCli @closedb nil;
0;;

/*-----------------------*/
fun IniDMI(s)=
	_DMSregisterDMI this @action nil @clidestroyed @beforeclose
;;

/*-----------------------*/
fun TstErr(db)=
	if (SqlCod db)==SQL_ERROR then (
		_DMSsend this DMSsender CSqlErr SqlDescErr db;
		1
	)
	else 0
;;

/*-----------------------*/
fun mkCols(lst)=
	if lst==nil then nil
	else let lst -> [[c _] nxt] in
	     strcat c if nxt==nil then nil else strcat "," mkCols nxt
;;

/*-----------------------*/
fun mkValues(lst)=
	if lst==nil then nil
	else let lst -> [_ nxt] in
	     strcat "?" if nxt==nil then nil else strcat "," mkValues nxt
;;

/*-----------------------*/
fun mkSet(lst)=
	if lst==nil then nil
	else let lst -> [[c _] nxt] in
	     strcatn c::"=?"::(if nxt==nil then nil else strcat "," mkSet nxt)::nil
;;

/*-----------------------*/
fun PadNil(lst)=
	if lst==nil then nil
	else let lst -> [val nxt] in
	     (if (strlen val)<=0 then valnil else val)::PadNil nxt
;;

/*-----------------------*/
fun __GetTables()=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then
			let SqlRequest curcli.Db "GET_TABLES" nil -> res in
				if !(TstErr curcli.Db) then
					_DMSsend this DMSsender CRetGetTables [strbuild res]
				else nil
		else nil
;;

/*-----------------------*/
fun __GetCols(s)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then
			let SqlRequest curcli.Db "GET_COLUMNS" (SQL_NIL s)::nil -> res in
				if !(TstErr curcli.Db) then (
					set curcli.Table=s;
					set curcli.LstCols=res;
					set curcli.Cols=mkCols res;
					set curcli.Values=mkValues res;
					set curcli.Set=mkSet res;
					_DMSsend this DMSsender CRetGetCols [strbuild res]
				)
				else nil
		else nil
;;

/*-----------------------*/
fun SendRow(D,u,row)=
	let u -> [deb nb cpt] in
		if (cpt<deb) then (
			mutate u <- [_ _ cpt+1];
			0
		)
		else
		if (nb==nil) || (cpt<(deb+nb)) then (
			_DMSsend this DMSsender CRetGetRow [strbuild (PadNil row)::nil];
			mutate u <- [_ _ cpt+1];
			0
		)
		else 1
;;

/*-----------------------*/
fun EndRows(curcli)=
	if (SqlCod curcli.Db)==SQL_NO_DATA then
		_DMSsend this DMSsender CNoData []
	else
		let SqlRequest curcli.Db strcat "SELECT COUNT(*) FROM " curcli.Table nil -> res in
			if !(TstErr curcli.Db) then
				_DMSsend this DMSsender CRetGetRows [hd hd res]
			else nil
;;

/*-----------------------*/
fun __GetRows(deb,nb)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			SqlFetch curcli.Db @SendRow [deb nb 1];
			SqlRequest curcli.Db strcatn "SELECT "::curcli.Cols::" FROM "::curcli.Table::" ORDER BY "::(hd hd curcli.LstCols)::nil nil;
			if !(TstErr curcli.Db) then
				EndRows curcli
			else nil
		)
		else nil
;;

/*-----------------------*/
fun __GetCount(s)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then
			let SqlRequest curcli.Db strcat "SELECT COUNT(*) FROM " s nil -> res in
				if !(TstErr curcli.Db) then
					_DMSsend this DMSsender CRetGetCount [s hd hd res]
				else nil
		else nil
;;

/*-----------------------*/
fun __Commit()=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			SqlCommit curcli.Db;
			if !(TstErr curcli.Db) then
				_DMSsend this DMSsender CRetDone []
			else nil
		)
		else nil
;;

/*-----------------------*/
fun __Rollb()=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			SqlRollback curcli.Db;
			if !(TstErr curcli.Db) then
				_DMSsend this DMSsender CRetDone []
			else nil
		)
		else nil
;;

/*-----------------------*/
fun __Auto(par)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			if par==1 then
				SqlSetAttr curcli.Db AUTOCOMMIT_ON
			else
				SqlSetAttr curcli.Db AUTOCOMMIT_OFF;
			if !(TstErr curcli.Db) then
				_DMSsend this DMSsender CRetDone []
			else nil
		)
		else nil
;;

/*-----------------------*/
fun S2Param(typ,s)=
	if !strcmp typ "SQL_CHAR" then
		SQL_CHAR s
	else if !strcmp typ "SQL_INTEGER" then
		SQL_INTEGER s
	else if !strcmp typ "SQL_NUMERIC" then
		SQL_NUMERIC s 
	else if !strcmp typ "SQL_BIGINT" then
		SQL_BIGINT s
	else if !strcmp typ "SQL_BINARY" then
		SQL_BINARY s  
	else if !strcmp typ "SQL_BIT" then
		SQL_BIT s
	else if !strcmp typ "SQL_DATE" then
		SQL_DATE s
	else if !strcmp typ "SQL_DECIMAL" then
		SQL_DECIMAL s
	else if !strcmp typ "SQL_DOUBLE" then
		SQL_DOUBLE s
	else if !strcmp typ "SQL_FLOAT" then
		SQL_FLOAT s
	else if !strcmp typ "SQL_LONGVARBINARY" then
		SQL_LONGVARBINARY s 
	else if !strcmp typ "SQL_LONGVARCHAR" then
		SQL_LONGVARCHAR s
	else if !strcmp typ "SQL_REAL" then
		SQL_REAL s
	else if !strcmp typ "SQL_SMALLINT" then
		SQL_SMALLINT s
	else if !strcmp typ "SQL_TIME" then
		SQL_TIME s
	else if !strcmp typ "SQL_TIMESTAMP" then
		SQL_TIMESTAMP s
	else if !strcmp typ "SQL_TINYINT" then
		SQL_TINYINT s
	else if !strcmp typ "SQL_VARBINARY" then
		SQL_VARBINARY s
	else if !strcmp typ "SQL_VARCHAR" then
		SQL_VARCHAR s
	else nil
;;

/*-----------------------*/
fun mkWhere(lstcol,lstval)=
	if lstcol==nil then nil
	else
		let lstcol -> [[c _] ncol] in
		let lstval -> [val nval] in
	     strcatn (if !strcmp val valnil then strcatn "("::c::"=? OR "::c::" IS NULL)"::nil else strcat c "=?")::
	             (if ncol==nil then nil else strcat " AND " mkWhere ncol nval)::nil
;;

/*-----------------------*/
fun mkPar(lstcol,lstval)=
	if lstcol==nil then nil
	else
		let lstcol -> [[_ [t _]] ncol] in
		let lstval -> [val nval] in
			(S2Param t if !strcmp val valnil then "" else val)::(mkPar ncol nval)
;;

/*-----------------------*/
fun __ModRow(sval,smod)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			SqlRequest curcli.Db strcatn "UPDATE "::curcli.Table::" SET "::curcli.Set::" WHERE "::(mkWhere curcli.LstCols hd strextr sval)::nil
				conclst mkPar curcli.LstCols hd strextr smod mkPar curcli.LstCols hd strextr sval;
			TstErr curcli.Db
		)
		else nil
;;

/*-----------------------*/
fun __SupRow(sval)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			SqlRequest curcli.Db strcatn "DELETE FROM "::curcli.Table::" WHERE "::(mkWhere curcli.LstCols hd strextr sval)::nil
				mkPar curcli.LstCols hd strextr sval;
			TstErr curcli.Db
		)
		else nil
;;

/*-----------------------*/
fun __InsRow(smod)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			SqlRequest curcli.Db strcatn "INSERT INTO "::curcli.Table::" ("::curcli.Cols::") VALUES("::curcli.Values::")"::nil
		  	mkPar curcli.LstCols hd strextr smod;
			TstErr curcli.Db
		)
		else nil
;;

/*-----------------------*/
fun __ExeSql(req,show,deb,nb)=
	let filtcli DMSsender -> curcli in
		if curcli!=nil then (
			if show==1 then
				SqlFetch curcli.Db @SendRow [deb nb 1]
			else nil;
			SqlRequest curcli.Db req nil;
			if !(TstErr curcli.Db) then
				EndRows curcli
			else nil
		)
		else nil
;;