// a CDEV access interface for tcl
// Johannes van Zeijts, March 95, first version
//                      May   95, second version, using Walt Akers callback example 
//                      Dec   95, added arbitrary dimensional array output and context
//                      Jan   96, added handling of strings with spaces
//			Aug   96, deleted callbackinfo when we are not monitoring
//			Aug   96, converted to tcl7.5
// 		Nov 1, 96, moved to cdev 1.4
//			March, 97, overhaul, allowed multiple devices
//			Feb, 98 Make it work with select event handling
// 			For generic services this works only in cdev/1.6.2
// January 1999: Complete rewrite using Tcl_Obj model

#include <tcl.h>
#include <math.h>
#include <cdevData.h>
#include <cdevSystem.h>
#include <cdevRequestObject.h>

const int VALUE = cdevData::addTag("value");
static int cdevdebug = 0;

/** Handle double *data, recursively if dimension > 1. Result is a Tcl_ListObj
	@author Johannes van Zeijts
*/
Tcl_Obj* HandleLevel(double *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewDoubleObj(res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle float *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(float *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewDoubleObj((double)res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle short *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(short *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewIntObj((int)res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle uint *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(unsigned short *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewIntObj((int)res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle long *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(long *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewLongObj(res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle ulong *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(unsigned long *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewLongObj((long)res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle uchar (byte) *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(unsigned char *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewIntObj((int)res[count]);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/** Handle Timestamp *data, recursively if dimension > 1. Result is a Tcl_ListObj
 Each entry is a list of length 2 (seconds / nseconds)
*/
Tcl_Obj* HandleLevel(cdev_TS_STAMP *res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	Tcl_Obj *ts[2];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) {
			ts[0] = Tcl_NewLongObj(res[count].secPastEpoch);
			ts[1] = Tcl_NewLongObj(res[count].nsec);
			list[i] = Tcl_NewListObj(2,ts);
		}
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Handle char* *data, recursively if dimension > 1. Result is a Tcl_ListObj
Tcl_Obj* HandleLevel(char **res, int &count, int level, cdevBounds *bounds, int dim) {
	int len = bounds[level].length;
	Tcl_Obj *list[len];
	if (level == dim-1) {
		for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewStringObj(res[count],-1);
	} else {
		for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
	}	
	return Tcl_NewListObj(len, list);
}

/// Convert a tagged entry inside a cdevData to a Tcl_Obj
Tcl_Obj* Tcl_ObjFromcdevData(int tag, cdevData* data) {
	int type = data->getType(tag);
	if (type == CDEV_INVALID) {
		Tcl_Obj* obj = Tcl_NewObj();
		Tcl_AppendStringsToObj(obj,NULL);
		return obj;
	}
	size_t dim;
	data->getDim(tag, &dim);
if (dim == 0) {
	if (type == CDEV_DOUBLE || type == CDEV_FLOAT) {
		double res;
		data->get(tag, &res);
		return Tcl_NewDoubleObj(res);
	} else if (type == CDEV_INT32) {
		long res;
		data->get(tag, &res);
		return Tcl_NewLongObj(res);
	} else if (type == CDEV_STRING) {
		char *s;
		data->find(tag, (void*&) s);
		return Tcl_NewStringObj(s,-1);
	} else if (type == CDEV_INT16) {
		int res;
		data->get(tag, &res);
		return Tcl_NewIntObj(res);
	} else if (type == CDEV_UINT16) {
		int res;
		data->get(tag, &res);
		return Tcl_NewIntObj(res);
	} else if (type == CDEV_UINT32) {
		unsigned long res;
		data->get(tag, &res);
		return Tcl_NewLongObj((long)res);
	} else if (type == CDEV_BYTE) {
		unsigned char res;
		data->get(tag, &res);
		return Tcl_NewIntObj((int)res);
	} else if (type == CDEV_TIMESTAMP) {
		cdev_TS_STAMP t;
		data->get(tag, &t);
		Tcl_Obj *ts[2];
		ts[0] = Tcl_NewLongObj(t.secPastEpoch);
		ts[1] = Tcl_NewLongObj(t.nsec);
		return Tcl_NewListObj(2, ts);
	} else {
		Tcl_Obj *obj = Tcl_NewStringObj("unknown tag: ",-1);
		char *s; cdevData::tagI2C(tag, s);
		Tcl_AppendStringsToObj(obj,s,NULL);
		return obj;
	}
} else {
// dim > 0
		cdevBounds Bounds[dim];
		data->getBounds(tag, Bounds, dim);
		int count = 0;
		if (type == CDEV_DOUBLE) {
			double *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_FLOAT) {
			float *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_INT32) {
			long *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_STRING) {
			char **res;
			data->find(tag, (void*&) res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_INT16) {
			short *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_UINT16) {
			unsigned short *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_UINT32) {
			unsigned long *res;
			data->find(tag, (void*&) res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_BYTE) {
			unsigned char *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else if (type == CDEV_TIMESTAMP) {
			cdev_TS_STAMP *res;
			data->find(tag, (void*&)res);
			return HandleLevel(res, count, 0, Bounds, dim);
		} else {
			Tcl_Obj *obj = Tcl_NewStringObj("unknown tag: ",-1);
			char *s; cdevData::tagI2C(tag, s);
			Tcl_AppendStringsToObj(obj,s,NULL);
			return obj;
		}
	}
}
/// Keeps parsed command line data, and contains callback information
class Tcl_cdevData {
public:
	Tcl_cdevData(Tcl_Interp*, int, char**);
	~Tcl_cdevData();
	int unroll, status, taglen, *statuss, *taglist;
	cdevData *out, *context;
	Tcl_Obj *cbtag, *tags, *devices;
	int hasContext(), hasData(), isAsynch();

	static void ObjIniter();
	static Tcl_Obj *arrayname;
	static Tcl_Obj *statusname;
	static Tcl_Obj *donename;
	static Tcl_Interp *interp;
	
	static Tcl_Obj* getCdevErrorCode(int);
};

/// Need to incr the refcount of the static Tcl_Obj, otherwise they may be removed by the tcl memory manager
void Tcl_cdevData::ObjIniter() {
	Tcl_IncrRefCount(arrayname);
	Tcl_IncrRefCount(statusname);
	Tcl_IncrRefCount(donename);
}

Tcl_Obj *Tcl_cdevData::arrayname = Tcl_NewStringObj("Control",-1);
Tcl_Obj *Tcl_cdevData::statusname = Tcl_NewStringObj("CdevStatus",-1);
Tcl_Obj *Tcl_cdevData::donename = Tcl_NewStringObj("CdevDone",-1);

Tcl_Interp *Tcl_cdevData::interp;

Tcl_cdevData::~Tcl_cdevData() {
	delete out;
	delete context;
	delete taglist;
	delete statuss;
	if (tags != NULL) Tcl_DecrRefCount(tags);
	if (cbtag != NULL) Tcl_DecrRefCount(cbtag);
	if (devices != NULL) Tcl_DecrRefCount(devices);
}

/// Convert int into a CDEV error string
Tcl_Obj *Tcl_cdevData::getCdevErrorCode(int code) {
	static Tcl_Obj *objm2= Tcl_NewStringObj("CDEV_WARNING",-1);
	static Tcl_Obj *objm1= Tcl_NewStringObj("CDEV_ERROR",-1);
	static Tcl_Obj *obj0 = Tcl_NewStringObj("CDEV_SUCCESS",-1);
	static Tcl_Obj *obj1 = Tcl_NewStringObj("CDEV_INVALIDOBJ",-1);
	static Tcl_Obj *obj2 = Tcl_NewStringObj("CDEV_INVALIDARG",-1);
	static Tcl_Obj *obj3 = Tcl_NewStringObj("CDEV_INVALIDSVC",-1);
	static Tcl_Obj *obj4 = Tcl_NewStringObj("CDEV_INVALIDOP",-1);
	static Tcl_Obj *obj5 = Tcl_NewStringObj("CDEV_NOTCONNECTED",-1);
	static Tcl_Obj *obj6 = Tcl_NewStringObj("CDEV_IOFAILED",-1);
	static Tcl_Obj *obj7 = Tcl_NewStringObj("CDEV_CONFLICT",-1);
	static Tcl_Obj *obj8 = Tcl_NewStringObj("CDEV_NOTFOUND",-1);
	static Tcl_Obj *obj9 = Tcl_NewStringObj("CDEV_TIMEOUT",-1);
	static Tcl_Obj *obj10= Tcl_NewStringObj("CDEV_CONVERT",-1);
	static Tcl_Obj *obj11= Tcl_NewStringObj("CDEV_OUTOFRANGE",-1);
	static Tcl_Obj *obj12= Tcl_NewStringObj("CDEV_NOACCESS",-1);
	static Tcl_Obj *obj13= Tcl_NewStringObj("CDEV_ACCESSCHANGED",-1);
	static Tcl_Obj *obj60= Tcl_NewStringObj("CDEV_DISCONNECTED",-1);
	static Tcl_Obj *obj61= Tcl_NewStringObj("CDEV_RECONNECTED",-1);
	static Tcl_Obj *obj70= Tcl_NewStringObj("CDEV_DELETE_CALLBACK",-1);
	static Tcl_Obj *obj80= Tcl_NewStringObj("CDEV_NOTCONSERVER",-1);
	static Tcl_Obj *obj81= Tcl_NewStringObj("CDEV_NOTFOUNDSERVER",-1);
	static Tcl_Obj *obj82= Tcl_NewStringObj("CDEV_CONN_TIMEOUT",-1);
	static Tcl_Obj *obj86= Tcl_NewStringObj("CDEV_BADIO",-1);
	static Tcl_Obj *obj87= Tcl_NewStringObj("CDEV_OVERFLOW",-1);
	static Tcl_Obj *obj88= Tcl_NewStringObj("CDEV_INCOMPLETE",-1);
	static Tcl_Obj *obj89= Tcl_NewStringObj("CDEV_CBK_FINISHED",-1);
	static Tcl_Obj *obj90= Tcl_NewStringObj("CDEV_PAUSED",-1);
	static Tcl_Obj *obj91= Tcl_NewStringObj("CDEV_MSG_ERR",-1);
	static Tcl_Obj *objdefault= Tcl_NewStringObj("UNKNOWN",-1);

	Tcl_Obj *obj;
	switch (code) {
		case -2: obj = objm2; break;
		case -1: obj = objm1; break;
		case  0: obj = obj0;  break;
		case  1: obj = obj1;  break;
		case  2: obj = obj2;  break;
		case  3: obj = obj3;  break;
		case  4: obj = obj4;  break;
		case  5: obj = obj5;  break;
		case  6: obj = obj6;  break;
		case  7: obj = obj7;  break;
		case  8: obj = obj8;  break;
		case  9: obj = obj9;  break;
		case 10: obj = obj10;  break;
		case 11: obj = obj11;  break;
		case 12: obj = obj12;  break;
		case 13: obj = obj13;  break;
		case 60: obj = obj60;  break;
		case 61: obj = obj61;  break;
		case 70: obj = obj70;  break;
		case 80: obj = obj80;  break;
		case 81: obj = obj81;  break;
		case 82: obj = obj82;  break;
		case 86: obj = obj86;  break;
		case 87: obj = obj87;  break;
		case 88: obj = obj88;  break;
		case 89: obj = obj89;  break;
		case 90: obj = obj90;  break;
		case 91: obj = obj91;  break;
		default: obj = objdefault;
	}
	Tcl_IncrRefCount(obj);
	return obj;
}

int Tcl_cdevData::hasContext() {
	if (context == NULL) return 0;
	cdevDataIterator iterator(context);
	return iterator.init();
}

int Tcl_cdevData::hasData() {
	cdevDataIterator iterator(out);
	return iterator.init();
}

int Tcl_cdevData::isAsynch() {
	return (cbtag != NULL);
}

/// Parses its arguments into a cdevData result, context, and switches
Tcl_cdevData::Tcl_cdevData(Tcl_Interp*, int argc, char** argv) {
	int tag, i, j, len, objc;
	Tcl_Obj *obj = Tcl_NewObj();
	Tcl_Obj **objv;
	out = new cdevData();
	context = NULL;
	cdevData *ptr = out;
	status = TCL_OK;
	statuss = NULL;
	taglen = 0;
	unroll = 0;
	taglist = NULL;
	cbtag = NULL;
	tags = NULL;
	devices = NULL;
	for(i=0; i<argc; ++i) {
		Tcl_SetStringObj(obj, argv[i], -1);
		Tcl_ListObjGetElements(interp, obj, &objc, &objv);	
		if (objc == 2) { // most often the case
			tag = cdevData::addTag(Tcl_GetStringFromObj(objv[0], &len));
			Tcl_ListObjGetElements(interp, objv[1], &objc, &objv);	
			if (objc == 1) { // scalar
				long l; double d;
				if (Tcl_GetLongFromObj(NULL, objv[0], &l) == TCL_OK) {
					ptr->insert(tag, l);
				} else if (Tcl_GetDoubleFromObj(NULL, objv[0], &d) == TCL_OK) {
					ptr->insert(tag, d);
				} else {
					ptr->insert(tag, Tcl_GetStringFromObj(objv[0], &len));
				}
			} else if (objc > 1) {
				long l; double d;
				if (Tcl_GetLongFromObj(NULL, objv[0], &l) == TCL_OK) {
					long lv[objc];
					lv[0] = l;
					for (int ic=1; ic<objc ; ++ic) {
						if (Tcl_GetLongFromObj(interp, objv[ic], &lv[ic]) != TCL_OK) {
							status = TCL_ERROR;
							break;
						}
					}
					ptr->insert(tag, lv, objc);		
				} else if (Tcl_GetDoubleFromObj(NULL, objv[0], &d) == TCL_OK) {
					double dv[objc];
					dv[0] = d;
					for (int ic=1; ic<objc ; ++ic) {
						if (Tcl_GetDoubleFromObj(interp, objv[ic], &dv[ic]) != TCL_OK) {
							status = TCL_ERROR;
							break;
						}
					}
					ptr->insert(tag, dv, objc);		
				} else {				
					char *s[objc];
					for(j=0; j<objc; ++j) s[j] = Tcl_GetStringFromObj(objv[j], &len);
					ptr->insert(tag, s, objc);	
				}
			}
		} else if (objc == 1) {
			char *s = Tcl_GetStringFromObj(obj, &len);
			if (strcmp(s, "-context") == 0) {
				context = new cdevData();
				ptr = context;
			} else if (strcmp(s, "-tags") == 0) {
				if (++i == argc) {
					Tcl_AppendResult(interp, " expecting tags", NULL);
					status = TCL_ERROR;
					break;
				}
				Tcl_SetStringObj(obj, argv[i], -1);
				Tcl_ListObjGetElements(interp, obj, &objc, &objv);
				taglen = objc; taglist = new int[taglen];
				tags = Tcl_DuplicateObj(obj);
				for (j=0; j<objc; ++j) {
					taglist[j] = cdevData::addTag(Tcl_GetStringFromObj(objv[j], &len));
				}
			} else if (strcmp(s, "-unroll") == 0) {
				if (++i == argc) {
					Tcl_AppendResult(interp, " expecting number", NULL);
					status = TCL_ERROR;
					break;
				}
				Tcl_SetStringObj(obj, argv[i], -1);
				if (Tcl_GetIntFromObj(interp, obj, &unroll) != TCL_OK) {
					status = TCL_ERROR;
					break;
				}
			} else {
				if (i != argc-1) {
				Tcl_AppendResult(interp, " expecting callbacktag at end", NULL);
				status = TCL_ERROR;
				break;
				}
				cbtag = Tcl_NewStringObj(argv[i],-1);
			}
		} else { // This is a string with spaces
			tag = cdevData::addTag(Tcl_GetStringFromObj(objv[0], &len));
			Tcl_Obj *concat = Tcl_ConcatObj(objc-1, objv+1);
			ptr->insert(tag, Tcl_GetStringFromObj(concat, &len));
			Tcl_DecrRefCount(concat);			
		}
	}
	Tcl_DecrRefCount(obj);
}

/// Based on the list of tags in the Tcl_cdevData, return a Tcl_List with the converted cdevData
Tcl_Obj* Cdev_HandleResult(Tcl_cdevData *data, cdevData &result) {
	if (data->taglen == 0) {
		return Tcl_ObjFromcdevData(VALUE, &result);
	} else {
		Tcl_Obj *objv[data->taglen+1];
		objv[0] = Tcl_ObjFromcdevData(VALUE, &result);
		for (int i=0; i<data->taglen; ++i) {
			objv[i+1] = Tcl_ObjFromcdevData(data->taglist[i], &result);
		}
		return Tcl_NewListObj(data->taglen+1, objv);
	}
}
/** entry point for cdev callbacks
	results are put in the global array 'Control'
	the '-tags' and '-unroll' options determine what is put it.
	the VALUE tag is always returned (even if is empty/not in the result cdevData)
*/
void Cdev_CallbackFunction(int status, void *userarg, cdevRequestObject&, cdevData &result) {
	Tcl_cdevData *data = (Tcl_cdevData *)userarg;
	if (data == NULL) return;
	if (cdevdebug == 1)	{
		int lenl;
		printf("callback %d %s\n", status, Tcl_GetStringFromObj(data->cbtag, &lenl));
		result.asciiDump();
	}
	Tcl_Obj *obj; int len;
	if (data->status != status) {
		data->status = status;
		obj = Tcl_NewObj();
		Tcl_SetIntObj(obj, status);
		obj = Tcl_ObjSetVar2(data->interp, data->statusname, data->cbtag, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
	}
	cdevDataIterator iterator(&result);
	if (iterator.init()) { // there are entries available
		if (data->unroll == 0) {
			obj = Cdev_HandleResult( data, result);
			obj = Tcl_ObjSetVar2(data->interp, data->arrayname, data->cbtag, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
		} else if (data->unroll == 1) {
			obj = Tcl_ObjFromcdevData(VALUE, &result);
			obj = Tcl_ObjSetVar2(data->interp, data->arrayname, data->cbtag, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
			for (int i=0; i<data->taglen; ++i) {
				obj = Tcl_ObjFromcdevData(data->taglist[i], &result);
				Tcl_Obj *tag; Tcl_ListObjIndex(data->interp, data->tags, i, &tag);
				Tcl_Obj *tagobj = Tcl_DuplicateObj(data->cbtag);
				Tcl_AppendStringsToObj(tagobj,".",Tcl_GetStringFromObj(tag, &len),NULL);
				obj = Tcl_ObjSetVar2(data->interp, data->arrayname, tagobj, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
				Tcl_DecrRefCount(tagobj);
			}
		} else if (data->unroll == 2) {
			Tcl_Obj **names, **values, *vtag = Tcl_ObjFromcdevData(VALUE, &result);
			int nameslen;
			Tcl_ListObjGetElements(data->interp, vtag, &nameslen, &names);			
			Tcl_ObjSetVar2(data->interp, data->arrayname, data->cbtag, vtag, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
			for (int i=0; i<data->taglen; ++i) {
				Tcl_Obj *tag, *listobj = Tcl_ObjFromcdevData(data->taglist[i], &result); // This better be a list of length len
				Tcl_ListObjGetElements(data->interp, listobj, &len, &values);
				if (len != nameslen) { Tcl_DecrRefCount(listobj); continue;}
			 	Tcl_ListObjIndex(data->interp, data->tags, i, &tag);
				for (int j=0; j<len; ++j) {
					int slen;
					Tcl_Obj *tagobj = Tcl_DuplicateObj(data->cbtag);
			 		Tcl_AppendStringsToObj(tagobj,".",Tcl_GetStringFromObj(names[j], &slen),".",Tcl_GetStringFromObj(tag, &slen),NULL);
					Tcl_ObjSetVar2(data->interp, data->arrayname, tagobj, values[j], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
					Tcl_DecrRefCount(tagobj);
				}
				Tcl_DecrRefCount(listobj);
			}
		}		
	}
	if ((cdevCallback::isTransactionDone() == 1) || (status == CDEV_CBK_FINISHED)) {
		Tcl_Obj *sobj = Tcl_NewObj();
		Tcl_SetIntObj(sobj, status);
		Tcl_ObjSetVar2(data->interp, data->donename, data->cbtag, sobj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
/// The multi device callback reuses the same data for each request. Do not delete it in that case
		if (data->statuss == NULL) delete data;
	}
}

/** Multi device callback, passes work to regular callback function
	The index into the device array is carried in the private data of the cdevRequestObject*
*/
void Cdev_MultiCallbackFunction(int status, void *userarg, cdevRequestObject& req, cdevData &result) {
	Tcl_cdevData *data = (Tcl_cdevData *)userarg;
	int index = (int) req.getPrivate();
	data->status = data->statuss[index];
	Tcl_Obj *obj, *savecb = data->cbtag;
	Tcl_ListObjIndex(data->interp, data->devices, index, &obj);
	data->cbtag = Tcl_DuplicateObj(obj);
	int len;
	Tcl_AppendStringsToObj(data->cbtag,".",Tcl_GetStringFromObj(savecb,&len),NULL);
	Cdev_CallbackFunction(status, userarg, req, result);
	data->statuss[index] = data->status;
	Tcl_DecrRefCount(data->cbtag);	
	data->cbtag = savecb;
}

typedef cdevRequestObject *cdevRequestObjectPtr;

/// Letter/Envelope class for (device/message) and (N devices/message)
class TclRequest {
public:
	TclRequest(Tcl_Interp *interp, int argc, char** argv);
	virtual ~TclRequest();
/// forwarded to the letter
	virtual int send(Tcl_cdevData *data, Tcl_Obj *&obj) {return Req->send(data, obj);}
/// forwarded to the letter pointer
	virtual int sendCallback(Tcl_cdevData *data) {return Req->sendCallback(data);}
/// forwarded to the letter pointer
	virtual int getStatus() {return Req->getStatus();}
protected:
	TclRequest(Tcl_Obj*, Tcl_Obj*);
	Tcl_Obj *device, *message;
/// The pointer to the letter
	TclRequest *Req;	
};

/// device/message for a single device
class TclSingleDeviceRequest : public TclRequest {
public:
	TclSingleDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m);
	~TclSingleDeviceRequest();
	int getStatus() {return status;}
	int send(Tcl_cdevData *data, Tcl_Obj *&);
	int sendCallback(Tcl_cdevData *data);
protected:
	int status;
	cdevRequestObjectPtr request;
};

/** devices/message for multiple devices
	If the collection code ever matures, this code would try to use that.
*/
class TclMultiDeviceRequest : public TclRequest {
public:
	TclMultiDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m);
	~TclMultiDeviceRequest();
	int send(Tcl_cdevData *data, Tcl_Obj *&);
	int getStatus() {return status;}
	int sendCallback(Tcl_cdevData *data);
protected:
	int number, status, *statuss;
	cdevRequestObjectPtr *requests;
};

/// Constructor of the envelope class
/// Create a letter class based on the length of the devices in argv[1]
TclRequest::TclRequest(Tcl_Interp *interp, int argc, char** argv) {
	device = Tcl_NewStringObj(argv[1],-1);
	message = Tcl_NewStringObj(argv[2],-1);	
	int objc;
	Tcl_ListObjLength(interp, device, &objc);
	if (objc == 1) {
		Req = new TclSingleDeviceRequest(interp, device, message);
	} else {
		Req = new TclMultiDeviceRequest(interp, device, message);
	}
}

/// Constructor for the letter class
TclRequest::TclRequest(Tcl_Obj* dev, Tcl_Obj*m) : device(dev), message(m) {
	Req = NULL;
}

TclRequest::~TclRequest() {
	delete Req;
	if (device != NULL) Tcl_DecrRefCount(device);
	if (message != NULL) Tcl_DecrRefCount(message);
}

TclSingleDeviceRequest::TclSingleDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m) : TclRequest(dev,m)  {
	int len;
	status = CDEV_SUCCESS;
	request = cdevRequestObject::attachPtr(Tcl_GetStringFromObj(device, &len), Tcl_GetStringFromObj(message, &len));
	if (request == NULL) {
		status = CDEV_INVALIDOBJ;
		Tcl_Obj *listv[3];
		listv[0] = Tcl_NewStringObj("Cannot find service for: ",-1);
		listv[1] = device;
		Tcl_IncrRefCount(device);
		listv[2] = message;
		Tcl_IncrRefCount(message);
		Tcl_SetObjResult(interp, Tcl_NewListObj(3, listv));
	}
}

TclSingleDeviceRequest::~TclSingleDeviceRequest() {
	device = NULL;
	message = NULL;
}

TclMultiDeviceRequest::TclMultiDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m) : TclRequest(dev,m)  {
	Tcl_Obj *obj, **objv;
	Tcl_ListObjGetElements(NULL, device, &number, &objv);
	int len;
	requests = new cdevRequestObjectPtr[number];
	statuss = new int[number];
	status = CDEV_SUCCESS;
	for (int i=0; i<number; ++i) {
		statuss[i] = CDEV_SUCCESS;
		requests[i] = cdevRequestObject::attachPtr(Tcl_GetStringFromObj(objv[i], &len), Tcl_GetStringFromObj(message, &len));
		if (requests[i] == NULL) {
			statuss[i] = CDEV_INVALIDOBJ;
			if (status == CDEV_SUCCESS) {
				status = CDEV_INVALIDOBJ;
				obj = Tcl_NewObj();
			} 
			Tcl_ListObjAppendElement(interp, obj, objv[i]);
		}
	}
	if (status != CDEV_SUCCESS) {
		Tcl_Obj *listv[3];
		listv[0] = Tcl_NewStringObj("Cannot find service for: ",-1);
		listv[1] = obj;
		listv[2] = message;
		Tcl_IncrRefCount(message);
		Tcl_SetObjResult(interp, Tcl_NewListObj(3, listv));
	}
}

TclMultiDeviceRequest::~TclMultiDeviceRequest() {
	delete requests;
	delete statuss;
	device = NULL;
	message = NULL;
}

/// synchronous send
int TclSingleDeviceRequest::send(Tcl_cdevData *data, Tcl_Obj *&obj) {
	if (status == CDEV_INVALIDOBJ) return status;
	if (data->hasContext()) request->setContext(*(data->context));
	cdevData result;
	status = request->send(data->out, result);
	obj = Cdev_HandleResult( data, result);
	return status;
}

/// asynchronous send
int TclSingleDeviceRequest::sendCallback(Tcl_cdevData *data) {
	if (status == CDEV_INVALIDOBJ) {
		Tcl_Obj *sobj = Tcl_NewObj();
		Tcl_SetIntObj(sobj, status);
		sobj = Tcl_ObjSetVar2(data->interp, data->statusname, data->cbtag, sobj, TCL_GLOBAL_ONLY);
		return status;
	}
	if (data->hasContext()) request->setContext(*(data->context));
	int len;
	cdevCallback *cb;
	data->status = 1000; // preset it to "UNKNOWN"
// initialize the status
	Tcl_Obj *sobj = Tcl_NewObj();
	Tcl_SetIntObj(sobj, data->status);
	sobj = Tcl_ObjSetVar2(data->interp, data->statusname, data->cbtag, sobj, TCL_GLOBAL_ONLY);
	if (strncmp(Tcl_GetStringFromObj(message, &len), "monitorOff", 10) == 0) {
		cb = new cdevCallback(Cdev_CallbackFunction, NULL);
	} else {
		cb = new cdevCallback(Cdev_CallbackFunction, (void *) data);
	}
	if (request->sendCallback(data->out, *cb) != CDEV_SUCCESS) {
		return CDEV_ERROR;
	}
	return CDEV_SUCCESS;
}

/// synchronous send
int TclMultiDeviceRequest::send(Tcl_cdevData *data, Tcl_Obj *&obj) {
	cdevData result;
	Tcl_Obj *objv[number];
	int oldstatus = status;
	status = CDEV_SUCCESS;
	for (int i=0; i<number; ++i) {
		if (statuss[i] == CDEV_SUCCESS) {
			if (data->hasContext()) requests[i]->setContext(*data->context);
			statuss[i] = requests[i]->send(data->out, result);	
			if (statuss[i] != CDEV_SUCCESS) {
				status = statuss[i];
			}
		}
		objv[i] = Cdev_HandleResult( data, result);
	}
	obj = Tcl_NewListObj(number, objv);
	if (oldstatus != CDEV_SUCCESS) status = oldstatus;
	return status;
}

/// asynchronous send
int TclMultiDeviceRequest::sendCallback(Tcl_cdevData *data) {
	Tcl_Obj **objv;
	Tcl_ListObjGetElements(NULL, device, &number, &objv);
	int len;
	cdevCallback *cb;
	data->devices = device;
	Tcl_IncrRefCount(device);
	data->statuss = new int[number];
	for (int j=0; j<number; ++j) {
		if (statuss[j] == CDEV_SUCCESS) {
			if (data->hasContext()) requests[j]->setContext(*(data->context));
			requests[j]->setPrivate((void*) j);
			data->statuss[j] = 1000; // preset it to "UNKNOWN"
			Tcl_Obj *sobj = Tcl_NewObj();
			Tcl_SetIntObj(sobj, data->statuss[j]);
			Tcl_Obj *st = Tcl_DuplicateObj(objv[j]);
			Tcl_AppendStringsToObj(st, ".", Tcl_GetStringFromObj(data->cbtag,&len), NULL);		
			Tcl_ObjSetVar2(data->interp, data->statusname, st, sobj, TCL_GLOBAL_ONLY);
			Tcl_DecrRefCount(st);
			if (strncmp(Tcl_GetStringFromObj(message, &len), "monitorOff", 10) == 0) {
				cb = new cdevCallback(Cdev_MultiCallbackFunction, NULL);
			} else {
				cb = new cdevCallback(Cdev_MultiCallbackFunction, (void *) data);
			}
			if (requests[j]->sendCallback(data->out, *cb) != CDEV_SUCCESS) {
			}
		} else { // RequestObj was invalid
			Tcl_Obj *sobj = Tcl_NewObj();
			Tcl_SetIntObj(sobj, statuss[j]);
			Tcl_Obj *st = Tcl_DuplicateObj(objv[j]);
			Tcl_AppendStringsToObj(st, ".", Tcl_GetStringFromObj(data->cbtag,&len), NULL);		
			Tcl_ObjSetVar2(data->interp, data->statusname, st, sobj, TCL_GLOBAL_ONLY);
			Tcl_DecrRefCount(st);
		}
	}
	return CDEV_SUCCESS;
}

static int Finished = 0; 

void Cdev_FileProc(ClientData clientData, int mask) {
	int fd = (int) clientData;
	if (mask == TCL_EXCEPTION) {
		Tcl_DeleteFileHandler(fd);
		return;
	}
	cdevSystem::defaultSystem().poll();
}
	
void Cdev_RegisterFD(int fd, int condition, void *) {
	if (Finished == 1) {
		return;
	}
	if (condition == 1) {
		Tcl_CreateFileHandler(fd, TCL_READABLE|TCL_EXCEPTION, Cdev_FileProc, (ClientData) fd);
	} else {
		Tcl_DeleteFileHandler(fd);
	}
}

void Cdev_ExitProc(ClientData) {
	Finished = 1; // cdev filehandler crashes when its deleted twice (at least that what I think is the problem)
}

/**
	Entry point for tcl command
	Steps:
		Attach to a RequestObject. Return TCL_ERROR if not valid (attachPtr returns NULL).
		Parse the command line arguments into a cdevData and switches.
		send or sendCallback the request.
*/
int CdevCmd(ClientData, Tcl_Interp *interp, int argc, char **argv) {
	if (argc < 3) {
		Tcl_AppendResult(interp,"usage: cdev $device $message \"$tag $value\" ...", NULL);
		return TCL_ERROR;
	}
	TclRequest request(interp, argc, argv);

	if (request.getStatus() != CDEV_SUCCESS) {
		return TCL_ERROR;
	}
	Tcl_cdevData *data = new Tcl_cdevData(interp, argc-3, argv+3);
	if (data->status != TCL_OK) {
		delete data;
		return TCL_ERROR;
	}
	Tcl_Obj *obj;
	if (data->isAsynch()) {
		request.sendCallback(data);
		cdevSystem::defaultSystem().flush();	
		cdevSystem::defaultSystem().poll();	
		// keep data around
	} else {
		request.send(data, obj);
	}
	if (request.getStatus() != CDEV_SUCCESS) {
		delete data;
		if (!data->isAsynch()) {
			Tcl_SetObjResult(interp, obj);
		}
		return TCL_ERROR;
	}
	if (!data->isAsynch()) {
		Tcl_SetObjResult(interp, obj);
		delete data;
	}
	return  TCL_OK;
}

int CdevErrorCodeCmd(ClientData, Tcl_Interp *interp, int argc, char **argv) {
	if (argc < 2) {
		Tcl_AppendResult(interp,"usage: cdeverrorcode $error", NULL);
		return TCL_ERROR;
	}
	Tcl_Obj *obj = Tcl_NewStringObj(argv[1], -1);
	int status;
	if (Tcl_GetIntFromObj(interp, obj, &status) != TCL_OK) {
		return TCL_ERROR;
	}
	Tcl_DecrRefCount(obj);
	Tcl_SetObjResult(interp, Tcl_cdevData::getCdevErrorCode(status));
	return TCL_OK;
}

int CdevDebugCmd(ClientData, Tcl_Interp *, int, char **) {
	if (cdevdebug == 0) {
		cdevdebug = 1;
	} else {
		cdevdebug = 0;
	}
	return TCL_OK;
}

#ifdef SUN 
#include <cdevCns/cdevCns.hxx> 
#endif
// Old way of polling, superseded by FileHandler calls, but since FD's are not working yet, still in use

void Cdev_UpdateProc(ClientData dummy) {
	cdevSystem::defaultSystem().poll();
	Tcl_CreateTimerHandler(200, Cdev_UpdateProc, dummy);
}

//extern "C" int Cdev_Init(Tcl_Interp *interp) {
extern"C"int Tclcdev_Init(Tcl_Interp *interp) {
 	int i, numFD = 20;
	int fds[numFD];
#ifdef SUN
	cdevCnsInit(); // Hook into the BNL ADO Nameserver
#endif
	Tcl_cdevData::interp = interp;
	Tcl_cdevData::ObjIniter();

// This installs cdev into the tcl FD select.
	cdevSystem::defaultSystem().getFd(fds, numFD);
	for (i=0;i<numFD;i++) {
		Cdev_RegisterFD(fds[i],1,NULL);
	}
	cdevSystem::defaultSystem().addFdChangedCallback(Cdev_RegisterFD, NULL);
	if(Tcl_PkgProvide(interp, "Cdev", "8.0") != TCL_OK) {
		return TCL_ERROR;
	}

// Alternatively call poll periodically
//	Cdev_UpdateProc(ClientData dummy);
	
	Tcl_CreateCommand(interp, "cdev", CdevCmd, (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateCommand(interp, "cdeverrorcode", CdevErrorCodeCmd, (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateCommand(interp, "cdevdebug", CdevDebugCmd, (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateExitHandler(Cdev_ExitProc, NULL);	
	return TCL_OK;
}