tdbc::odbc

# We need to enumerate the list of .c to .o lines here.
#
# In the following lines, $(srcdir) refers to the toplevel directory
# containing your extension.  If your sources are in a subdirectory,
# you will have to modify the paths to reflect this:
#
# sample.$(OBJEXT): $(srcdir)/generic/sample.c
#	$(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
#
# Setting the VPATH variable to a list of paths will cause the makefile
# to look into these paths when resolving .c to .obj dependencies.
# As necessary, add $(srcdir):$(srcdir)/compat:....
#========================================================================

VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win

 * Additional entry points in ODBCINST - all of these are optional
 * and resolved with Tcl_FindSymbol, not directly in Tcl_LoadLibrary.
 */

MODULE_SCOPE BOOL (INSTAPI* SQLConfigDataSourceW)(HWND, WORD, LPCWSTR,
						  LPCWSTR);
MODULE_SCOPE BOOL (INSTAPI* SQLConfigDataSource)(HWND, WORD, LPCSTR, LPCSTR);


MODULE_SCOPE BOOL (INSTAPI* SQLInstallerError)(WORD, DWORD*, LPSTR, WORD,
					       WORD*);

/*
 * Function that initialises the stubs
 */

#	define TCL_UNUSED(T) T
#   elif defined(__GNUC__) && (__GNUC__ > 2)
#	define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
#   else
#	define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
#   endif
#endif
# ifndef TCL_SIZE_MODIFIER
#   define TCL_SIZE_MODIFIER ""
#endif

/* Static data contained in this file */

TCL_DECLARE_MUTEX(hEnvMutex);	/* Mutex protecting the environment handle
				 * and its reference count */

static Tcl_LoadHandle odbcLoadHandle = NULL;
				/* Handle to the ODBC client library */
static Tcl_LoadHandle odbcInstLoadHandle = NULL;
				/* Handle to the ODBC installer library */
static SQLHENV hStaticEnv = SQL_NULL_HENV;
				/* Handle to the global ODBC environment */
static size_t hEnvRefCount = 0;	/* Reference count on the global environment */
static size_t sizeofSQLWCHAR = sizeof(SQLWCHAR);
				/* Preset, will be autodetected later */

/*
 * Objects to create within the literal pool
 */

static const char* const LiteralValues[] = {

	    DeletePerInterpData(_pidata);	\
	}					\
    } while(0)

/*
 * Structure that carries the data for an ODBC connection
 *
 *	The ConnectionData structure is refcounted to simplify the
 *	destruction of statements associated with a connection.
 *	When a connection is destroyed, the subordinate namespace that
 *	contains its statements is taken down, destroying them. It's
 *	not safe to take down the ConnectionData until nothing is
 *	referring to it, which avoids taking down the hDBC until the
 *	other objects that refer to it vanish.
 */

    } while(0)

/*
 * Structure that carries the data for an ODBC prepared statement.
 *
 *	Just as with connections, statements need to defer taking down
 *	their client data until other objects (i.e., result sets) that
 *	refer to them have had a chance to clean up. Hence, this
 *	structure is reference counted as well.
 */

typedef struct StatementData {
    size_t refCount;		/* Reference count */
    Tcl_Object connectionObject;
				/* The connection object */

    Tcl_Size nativeSqlLen;		/* Length of the statement */
    SQLWCHAR* nativeMatchPatternW;
				/* Match pattern for metadata queries */
    Tcl_Size nativeMatchPatLen;	/* Length of the match pattern */
    struct ParamData* params;	/* Pointer to an array of ParamData
				 * structures that describe the data types
				 * of substituted parameters. */
    SQLSMALLINT typeNum;	/* Type number for a query of data types */
    int flags;			/* Flags tracking the state of the
				 * StatementData */
} StatementData;
#define IncrStatementRefCount(x)		\
    do {					\
	++((x)->refCount);			\
    } while (0)

    SQLULEN precision;		/* Size of the expected data */
    SQLSMALLINT scale;		/* Digits after decimal point of the
				 * expected data */
    SQLSMALLINT nullable;	/* Flag == 1 if the parameter is nullable */
} ParamData;

#define PARAM_KNOWN	1<<0	/* Something is known about the parameter */
#define PARAM_IN	1<<1	/* Parameter is an input parameter */
#define PARAM_OUT	1<<2	/* Parameter is an output parameter */
				/* (Both bits are set if parameter is
				 * an INOUT parameter) */

/*
 * Structure describing an ODBC result set.  The object that the Tcl
 * API terms a "result set" actually has to be represented by an ODBC
 * "statement", since an ODBC statement can have only one set of results

 */

static SQLWCHAR*
GetWCharStringFromObj(
    Tcl_Obj* obj,		/* Tcl object whose string rep is desired */
    Tcl_Size* lengthPtr		/* Length of the string */
) {
    Tcl_Size len;	/* Length of the input string in bytes */
    char* bytes = Tcl_GetStringFromObj(obj, &len);
				/* UTF-8 representation of the input string */

    char* end = bytes + len;	/* End of UTF-8 representation */
    SQLWCHAR* retval;		/* Buffer to hold the converted string */
    SQLWCHAR* wcPtr;
    int shrink = 0;
    Tcl_UniChar ch = 0;

    len = (len + 1) * sizeofSQLWCHAR;

	    if ((sizeof(Tcl_UniChar) > 2) && (uch > 0xffff)) {
		*ptr16++ = (((uch - 0x10000) >> 10) & 0x3ff) | 0xd800;
		uch = ((uch - 0x10000) & 0x3ff) | 0xdc00;
	    }
	    if (uch > 0x7f) {
		shrink = 1;
	    }
	    *ptr16++ = (unsigned short)uch;
	}
	*ptr16 = 0;
	len = ptr16 - (unsigned short*) retval;
	wcPtr = (SQLWCHAR*) ptr16;
    } else {
	int *ptr32 = (int*) wcPtr;

 * (Option Value Changed).
 *
 *-----------------------------------------------------------------------------
 */

static int
SQLStateIs(
    SQLSMALLINT handleType,	/* Type of handle reporting the state */
    SQLHANDLE handle,		/* Handle that reported the state */
    const char* sqlstate	/* State to look for */
) {
    SQLCHAR state[6];		/* SQL state code from the diagnostic record */
    SQLSMALLINT stateLen;	/* String length of the state code */
    SQLSMALLINT i;		/* Loop index */
    SQLRETURN rc;		/* SQL result */

 *	Returns a Tcl_Obj with the human-readable level.
 *
 *-----------------------------------------------------------------------------
 */

static Tcl_Obj*
TranslateOdbcIsolationLevel(
    SQLINTEGER level,		/* Isolation level */
    Tcl_Obj* literals[]		/* Pointer to the literal pool */
) {
    if (level & SQL_TXN_SERIALIZABLE) {
	return literals[LIT_SERIALIZABLE];
    }
    if (level & SQL_TXN_REPEATABLE_READ) {
	return literals[LIT_REPEATABLEREAD];

	    == NULL) {
	    Tcl_MutexUnlock(&hEnvMutex);
	    return SQL_NULL_HENV;
	}
	/*
	 * Allocate the ODBC environment
	 */
	rc = SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, &hStaticEnv);
	if (SQL_SUCCEEDED(rc)) {
	    rc = SQLSetEnvAttr(hStaticEnv, SQL_ATTR_ODBC_VERSION,
			       (SQLPOINTER) SQL_OV_ODBC3, 0);
	}
	if (!SQL_SUCCEEDED(rc)) {
	    /*
	     * The call failed. Report the error.
	     */
	    if (hStaticEnv != SQL_NULL_HENV) {
		if (interp != NULL) {
		    TransferSQLError(interp, SQL_HANDLE_ENV, hStaticEnv,
				     "(allocating environment handle)");
		}
		SQLFreeHandle(SQL_HANDLE_ENV, hStaticEnv);
		hStaticEnv = SQL_NULL_HENV;
	    } else {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("Could not allocate the "
						  "ODBC SQL environment.", -1));
		Tcl_SetErrorCode(interp, "TDBC", "GENERAL_ERROR",
				 "HY001", "ODBC", "-1", NULL);
	    }
	} else {
	    /*
	     * Detect real size of SQLWCHAR used by the driver manager.
	     */
	    SQLHDBC hDBC = SQL_NULL_HDBC;

	    sizeofSQLWCHAR = sizeof(SQLWCHAR);		/* fallback */
	    rc = SQLAllocHandle(SQL_HANDLE_DBC, hStaticEnv, &hDBC);
	    if (SQL_SUCCEEDED(rc)) {
		SQLSMALLINT i, infoLen;
		char info[64];

		rc = SQLGetInfoW(hDBC, SQL_ODBC_VER, (SQLPOINTER) info,
				 sizeof(info), &infoLen);
		if (SQL_SUCCEEDED(rc) && infoLen >= 8) {

		SQLFreeHandle(SQL_HANDLE_DBC, hDBC);
	    }
	}
    }
    /*
     * On subsequent calls, simply adjust the refcount
     */
    if (hStaticEnv != SQL_NULL_HENV) {
	++hEnvRefCount;
    }
    Tcl_MutexUnlock(&hEnvMutex);
    return hStaticEnv;
}

/*
 *-----------------------------------------------------------------------------
 *
 * DismissHEnv --
 *

 */

static void
DismissHEnv(void)
{
    Tcl_MutexLock(&hEnvMutex);
    if (hEnvRefCount-- <= 1) {
	SQLFreeHandle(SQL_HANDLE_ENV, hStaticEnv);
	hStaticEnv = SQL_NULL_HANDLE;
	if (odbcInstLoadHandle != NULL) {
	    Tcl_FSUnloadFile(NULL, odbcInstLoadHandle);
	    odbcInstLoadHandle = NULL;
	}
	Tcl_FSUnloadFile(NULL, odbcLoadHandle);
	odbcLoadHandle = NULL;
    }

    Tcl_DString colNameDS;	/* Name of the current column, translated */
    Tcl_Obj* colNameObj;	/* Name of the current column, packaged in
				 * a Tcl_Obj */
    Tcl_HashTable nameHash;	/* Hash table to manage column name
				 * uniqueness. */
    Tcl_HashEntry* nameEntry;	/* Hash table entry for the current name */
    int isNew;			/* Flag that column name is unique */
    Tcl_Size count;			/* Count to append to the name */
    char numbuf[TCL_INTEGER_SPACE];		/* Buffer to hold the appended count */
    SQLSMALLINT i;
    int retry;
    int status = TCL_ERROR;

    /* Create a hash table to manage column name uniqueness */

    Tcl_InitHashTable(&nameHash, TCL_STRING_KEYS);

	rdata->results = (ParamData*) ckalloc(nColumns * sizeof(ParamData));
	for (i = 0; i < nColumns; ++i) {
	    retry = 0;
	    do {

		/* Describe one column of the result set */

		rc = SQLDescribeColW(hStmt, (SQLUSMALLINT)(i + 1), colNameW,
				     colNameAllocLen, &colNameLen,
				     &(rdata->results[i].dataType),
				     &(rdata->results[i].precision),
				     &(rdata->results[i].scale),
				     &(rdata->results[i].nullable));

		/*
		 * Reallocate the name buffer and retry if the buffer was
		 * too small.
		 */

		if (colNameLen < colNameAllocLen) {
		    retry = 0;
		} else {
		    colNameAllocLen = (SQLSMALLINT)(2 * colNameLen + 1);
		    if (colNameW != colNameBuf) {
			ckfree((char*) colNameW);
		    }
		    colNameW = (SQLWCHAR*)
			ckalloc(colNameAllocLen * sizeofSQLWCHAR);
		    retry = 1;
		}

		 * Non-unique name - append a # and the number of times
		 * we've seen it before.
		 */

		count = PTR2INT(Tcl_GetHashValue(nameEntry));
		++count;
		Tcl_SetHashValue(nameEntry, INT2PTR(count));
		snprintf(numbuf, sizeof(numbuf), "#%" TCL_SIZE_MODIFIER "d", count);
		Tcl_AppendToObj(colNameObj, numbuf, -1);
	    }

	    /* Add column name to the list of column names */

	    Tcl_ListObjAppendElement(NULL, colNames, colNameObj);
	    Tcl_DStringFree(&colNameDS);


/*
 *-----------------------------------------------------------------------------
 *
 * ConnectionEndXcnMethod --
 *
 *	Method that requests that a pending transaction against a database
 *	be committed or rolled back.
 *
 * Usage:
 *	$connection commit
 * -or- $connection rollback
 *
 * Parameters:
 *	None.

 *	refcounts accurate
 *
 *-----------------------------------------------------------------------------
 */

static int
CloneCmd(
    TCL_UNUSED(Tcl_Interp *), /* Tcl interpreter */
    TCL_UNUSED(void *),		/* Environment handle to be discarded */
    void **newClientData	/* New environment handle to be used */
) {
    *newClientData = GetHEnv(NULL);
    return TCL_OK;
}


 */

static int
StatementConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of args to skip */
    Tcl_Object connectionObject;

    if (Tcl_ListObjGetElements(interp, tokens, &tokenc, &tokenv) != TCL_OK) {
	Tcl_DecrRefCount(tokens);
	goto freeSData;
    }
    nativeSql = Tcl_NewObj();
    Tcl_IncrRefCount(nativeSql);
    for (i = 0; i < tokenc; ++i) {
	tokenStr = Tcl_GetStringFromObj(tokenv[i], &tokenLen);


	switch (tokenStr[0]) {
	case '$':
	case ':':
	    Tcl_AppendToObj(nativeSql, "?", 1);
	    Tcl_ListObjAppendElement(NULL, sdata->subVars,
				     Tcl_NewStringObj(tokenStr+1, tokenLen-1));

	/*
	 * Try to describe the parameters for the sake of consistency
	 * in conversion and efficiency in execution.
	 */

	for (i = 0; i < nParams; ++i) {
	    rc = SQLDescribeParam(sdata->hStmt, (SQLUSMALLINT)(i+1),
				  &(sdata->params[i].dataType),
				  &(sdata->params[i].precision),
				  &(sdata->params[i].scale),
				  &(sdata->params[i].nullable));
	    if (SQL_SUCCEEDED(rc)) {
		/*
		 * FIXME: SQLDescribeParam doesn't actually describe

 */

static int
StatementConnectionMethod(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    TCL_UNUSED(int),			/* Parameter count */
    TCL_UNUSED(Tcl_Obj *const *)/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    StatementData* sdata;	/* The current statement */
    Tcl_Object connectionObject;
				/* The object representing the connection */

 */

static int
StatementParamListMethod(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    TCL_UNUSED(int),			/* Parameter count */
    TCL_UNUSED(Tcl_Obj *const *)	/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    StatementData* sdata;	/* The current statement */
    Tcl_Obj **paramNames;	/* Parameter list to the current statement */
    Tcl_Size nParams;	/* Parameter count for the current statement */

 */

static int
StatementParamtypeMethod(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    StatementData* sdata;	/* The current statement */
    int matchCount = 0;		/* The number of variables in the given
				 * statement that match the given one */

	targetName = Tcl_GetString(targetNameObj);
	if (!strcmp(paramName, targetName)) {
	    ++matchCount;

	    sdata->params[i].flags = dir;
	    sdata->params[i].dataType = odbcType;
	    sdata->params[i].precision = precision;
	    sdata->params[i].scale = (SQLSMALLINT)scale;
	    sdata->params[i].nullable = 1;
				/* TODO - Update TIP so that user
				 * can specify nullable? */
	}
    }
    if (matchCount == 0) {
	errorObj = Tcl_NewStringObj("unknown parameter \"", -1);

 */

static int
TablesStatementConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of initial args to this call */

 */

static int
ColumnsStatementConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of parameters to skip */

 */

static int
PrimarykeysStatementConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of parameters to skip */

 */

static int
ForeignkeysStatementConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of parameters to skip */

 *	instance metadata.
 *
 *-----------------------------------------------------------------------------
 */

static int
EvaldirectStatementConstructor(
    TCL_UNUSED(void *),
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of parameters to skip */

 */

static int
TypesStatementConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current statement object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* The number of leading args to skip */

    }

    /*
     * Stash the type number in the statement data, and set a flag
     * that that's what we have there.
     */

    sdata->typeNum = (SQLSMALLINT)typeNum;
    sdata->flags = STATEMENT_FLAG_TYPES;

    /* Attach the current statement data as metadata to the current object */


    Tcl_ObjectSetMetadata(thisObject, &statementDataType, sdata);
    return TCL_OK;

 */

static int
ResultSetConstructor(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current result set object */
    Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
				/* Number of skipped args in the

		} else {

		    /*
		     * We need to convert the character string to system
		     * encoding and store in rdata->bindStrings[nBound].
		     */
		    dataType = SQL_C_CHAR;
		    paramVal = Tcl_GetStringFromObj(paramValObj, &paramLen);

		    Tcl_DStringInit(&paramExternal);
		    (void)Tcl_UtfToExternalDString(NULL, paramVal, paramLen,
					     &paramExternal);
		    paramExternalLen = Tcl_DStringLength(&paramExternal);
		    rdata->bindStrings[nBound] = (SQLCHAR*)
			ckalloc(paramExternalLen + 1);
		    memcpy(rdata->bindStrings[nBound],

	    dataType = SQL_C_CHAR;
	    rdata->bindStrings[nBound] = NULL;
	    paramExternalLen = paramLen = 0;
	    rdata->bindStringLengths[nBound] = SQL_NULL_DATA;
	}
	rc = SQLBindParameter(rdata->hStmt,
			      (SQLUSMALLINT)(nBound + 1),
			      SQL_PARAM_INPUT, /* TODO - Fix this! */
			      dataType,
			      sdata->params[nBound].dataType,
			      sdata->params[nBound].precision,
			      sdata->params[nBound].scale,
			      rdata->bindStrings[nBound],
			      paramExternalLen,

 */

static int
ResultSetColumnsMethod(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current result set object */
    ResultSetData* rdata = (ResultSetData*)
	Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);

 */

static int
ResultSetNextresultsMethod(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    TCL_UNUSED(int),			/* Parameter count */
    TCL_UNUSED(Tcl_Obj *const *)	/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current result set object */
    ResultSetData* rdata = (ResultSetData*)
	Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);
				/* Data pertaining to the current result set */

static int
ResultSetNextrowMethod(
    void *clientData,	/* 1 if lists are to be returned, 0 if
				 * dicts are to be returned */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    int lists = (int)PTR2INT(clientData);
				/* Flag == 1 if lists are to be returned,
				 * 0 if dicts are to be returned */

    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current result set object */
    ResultSetData* rdata = (ResultSetData*)
	Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);

	    goto convertUnknown;
	}

    case SQL_BIGINT:
    convertWide:
	/* A wide integer */
	colLen = sizeof(colWide); colWide = 0;
	rc = SQLGetData(rdata->hStmt, (SQLUSMALLINT)(i+1), SQL_C_SBIGINT,
			(SQLPOINTER) &colWide, sizeof(colWide), &colLen);
	if (!SQL_SUCCEEDED(rc)) {
	    char info[80];
	    snprintf(info, sizeof(info), "(retrieving result set column #%d)\n", i+1);
	    TransferSQLError(interp, SQL_HANDLE_STMT, rdata->hStmt, info);
	    return TCL_ERROR;
	}
	if (colLen != SQL_NULL_DATA && colLen != SQL_NO_TOTAL) {
	    colObj = Tcl_NewWideIntObj((Tcl_WideInt)colWide);
	}
	break;

    case SQL_BIT:
    case SQL_INTEGER:
    case SQL_SMALLINT:
    case SQL_TINYINT:
    convertLong:
	/* An integer no larger than 'long' */
	colLen = sizeof(colLong.si); colLong.si = 0;
	rc = SQLGetData(rdata->hStmt, (SQLUSMALLINT)(i+1), SQL_C_SLONG,
			(SQLPOINTER) &colLong.si, sizeof(colLong.si), &colLen);
	if (!SQL_SUCCEEDED(rc)) {
	    char info[80];
	    snprintf(info, sizeof(info), "(retrieving result set column #%d)\n", i+1);
	    TransferSQLError(interp, SQL_HANDLE_STMT, rdata->hStmt, info);
	    ckfree(info);
	    return TCL_ERROR;

    case SQL_DOUBLE:
    convertDouble:
	/*
	 * A single- or double-precision floating point number.
	 * Reals are widened to doubles.
	 */
	colLen = sizeof(colDouble); colDouble = 0.0;
	rc = SQLGetData(rdata->hStmt, (SQLUSMALLINT)(i+1), SQL_C_DOUBLE,
			(SQLPOINTER) &colDouble, sizeof(colDouble),
			&colLen);
	if (!SQL_SUCCEEDED(rc)) {
	    char info[80];
	    snprintf(info, sizeof(info), "(retrieving result set column #%d)\n", i+1);
	    TransferSQLError(interp, SQL_HANDLE_STMT, rdata->hStmt, info);
	    ckfree(info);

	     * SQL_ERROR is returned. Store a background of zero so
	     * that it's always initialized.
	     */
	    colLen = 0;

	    /* Try to get the string */

	    rc = SQLGetData(rdata->hStmt, (SQLUSMALLINT)(i+1), dataType,
			    (SQLPOINTER) (((char*)colPtr)+offset),
			    colAllocLen - offset,
			    &colLen);
	    if (rc == SQL_SUCCESS_WITH_INFO
		&& SQLStateIs(SQL_HANDLE_STMT, rdata->hStmt, "01004")) {
		/*
		 * The requested buffer was too small to hold the

 */

static int
ResultSetRowcountMethod(
    TCL_UNUSED(void *),		/* Not used */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_ObjectContext context,	/* Object context  */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    Tcl_Object thisObject = Tcl_ObjectContextObject(context);
				/* The current result set object */
    ResultSetData* rdata = (ResultSetData*)
	Tcl_ObjectGetMetadata(thisObject, &resultSetDataType);
				/* Data pertaining to the current result set */

	WORD value;
    } flags[] = {
	{ "add",		ODBC_ADD_DSN },
	{ "add_system",		ODBC_ADD_SYS_DSN },
	{ "configure",		ODBC_CONFIG_DSN },
	{ "configure_system",	ODBC_CONFIG_SYS_DSN },
	{ "remove",		ODBC_REMOVE_DSN },
	{ "remove_system",	ODBC_REMOVE_SYS_DSN },
	{ NULL,			0 }
    };
    int flagIndex;		/* Index of the subcommand */
    WCHAR* driverName;		/* Name of the ODBC driver */
    WCHAR* attributes;		/* NULL-delimited attribute values */
    char errorMessage[SQL_MAX_MESSAGE_LENGTH+1];
				/* Error message from ODBC operations */

	sep = "";
	Tcl_DStringInit(&retvalDS);
	errorCodeObj = Tcl_NewStringObj("TDBC ODBC", -1);
	Tcl_IncrRefCount(errorCodeObj);
	finished = 0;
	while (!finished) {
	    errorMessageLen = SQL_MAX_MESSAGE_LENGTH;
	    errorMessageStatus = (RETCODE)
		SQLInstallerError((WORD)i, &errorCode, errorMessage,
				   SQL_MAX_MESSAGE_LENGTH-1, &errorMessageLen);
	    switch(errorMessageStatus) {
	    case SQL_SUCCESS:
		Tcl_DStringAppend(&retvalDS, sep, -1);
		Tcl_DStringInit(&errorMessageDS);
		(void)	Tcl_ExternalToUtfDString(NULL, errorMessage, errorMessageLen,
					 &errorMessageDS);

	WORD value;
    } flags[] = {
	{ "add",		ODBC_ADD_DSN },
	{ "add_system",		ODBC_ADD_SYS_DSN },
	{ "configure",		ODBC_CONFIG_DSN },
	{ "configure_system",	ODBC_CONFIG_SYS_DSN },
	{ "remove",		ODBC_REMOVE_DSN },
	{ "remove_system",	ODBC_REMOVE_SYS_DSN },
	{ NULL,			0 }
    };
    int flagIndex;		/* Index of the subcommand */
    Tcl_DString driverNameDS;
    Tcl_DString attributesDS;
    char* driverName;		/* Name of the ODBC driver in system
				 * encoding */

				  "operation", 0, &flagIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Convert driver name to the appropriate encoding */

    Tcl_DStringInit(&driverNameDS);
    p = Tcl_GetStringFromObj(objv[2], &driverNameLen);

    (void)Tcl_UtfToExternalDString(NULL, p, driverNameLen, &driverNameDS);
    driverName = Tcl_DStringValue(&driverNameDS);
    driverNameLen = Tcl_DStringLength(&driverNameDS);

    /*
     * Convert driver attributes to the appropriate encoding, separated
     * by NUL bytes.
     */

    attrObj = Tcl_NewObj();
    Tcl_IncrRefCount(attrObj);
    sep = "";
    for (i = 3; i < objc; ++i) {
	Tcl_AppendToObj(attrObj, sep, -1);
	Tcl_AppendObjToObj(attrObj, objv[i]);
	sep = "\xc0\x80";
    }
    Tcl_AppendToObj(attrObj, "\xc0\x80", 2);
    Tcl_DStringInit(&attributesDS);
    p = Tcl_GetStringFromObj(attrObj, &attrLen);

    (void)Tcl_UtfToExternalDString(NULL, p, attrLen, &attributesDS);
    attributes = Tcl_DStringValue(&attributesDS);
    attrLen = Tcl_DStringLength(&attributesDS);
    Tcl_DecrRefCount(attrObj);

    /*
     * Configure the data source

	sep = "";
	Tcl_DStringInit(&retvalDS);
	errorCodeObj = Tcl_NewStringObj("TDBC ODBC", -1);
	Tcl_IncrRefCount(errorCodeObj);
	finished = 0;
	while (!finished) {
	    errorMessageLen = SQL_MAX_MESSAGE_LENGTH;
	    errorMessageStatus = (RETCODE)
		SQLInstallerError((WORD)i, &errorCode, errorMessage,
				  SQL_MAX_MESSAGE_LENGTH-1, &errorMessageLen);
	    switch(errorMessageStatus) {
	    case SQL_SUCCESS:
		Tcl_DStringAppend(&retvalDS, sep, -1);
		Tcl_DStringInit(&errorMessageDS);
		(void)Tcl_ExternalToUtfDString(NULL, errorMessage, errorMessageLen,
					 &errorMessageDS);

    # The 'tables' method returns a dictionary describing the tables
    # in the database

    method tables {{pattern %}} {
	set stmt [::tdbc::odbc::tablesStatement create \
		      Stmt::[incr statementSeq] [self] $pattern]
	set status [catch {
	    set retval {}
	    $stmt foreach -as dicts row {
		if {[dict exists $row TABLE_NAME]} {
		    dict set retval [dict get $row TABLE_NAME] $row
		}
	    }
	    set retval

    # The 'primarykeys' method returns a dictionary describing the primary
    # keys of a table

    method primarykeys {tableName} {
	set stmt [::tdbc::odbc::primarykeysStatement create \
		      Stmt::[incr statementSeq] [self] $tableName]
	set status [catch {
	    set retval {}
	    $stmt foreach -as dicts row {
		foreach {odbcKey tdbcKey} {
		    TABLE_CAT		tableCatalog
		    TABLE_SCHEM		tableSchema
		    TABLE_NAME		tableName
		    COLUMN_NAME		columnName

    # The 'foreignkeys' method returns a dictionary describing the foreign
    # keys of a table

    method foreignkeys {args} {
	set stmt [::tdbc::odbc::foreignkeysStatement create \
		      Stmt::[incr statementSeq] [self] {*}$args]
	set status [catch {
	    set fkseq 0
	    set retval {}
	    $stmt foreach -as dicts row {
		foreach {odbcKey tdbcKey} {
		    PKTABLE_CAT		primaryCatalog
		    PKTABLE_SCHEM	primarySchema
		    PKTABLE_NAME	primaryTable

    # The 'evaldirect' evaluates driver-native SQL code without preparing it,
    # and returns a list of dicts (similar to '$connection allrows -as dicts').

    method evaldirect {sqlStatement} {
	set stmt [::tdbc::odbc::evaldirectStatement create \
		      Stmt::[incr statementSeq] [self] $sqlStatement]
	set status [catch {
	    $stmt allrows -as dicts
	} result options]
	catch {rename $stmt {}}
	return -level 0 -options $options $result
    }

    # The 'prepareCall' method gives a portable interface to prepare

		@idnum INTEGER OUTPUT
	    AS
	    SELECT @idnum = idnum FROM people WHERE name = @name
	}
	catch {unset stmt}
    }
    -body {
	set stmt [::db prepare {
	    DECLARE @x AS INTEGER;
	    EXECUTE find_person :name, @x OUTPUT;
	    SELECT @x AS result
	}]
	$stmt allrows {name barney}
    }
    -cleanup {
	if {[info exists stmt]} {
	    rename $stmt {}
	}
	db allrows {

		@idnum INTEGER OUTPUT
	    AS
	    SELECT @idnum = idnum FROM people WHERE name = @name
	}
	catch {unset stmt}
    }
    -body {
	set stmt [::db prepare {{CALL find_person(:name, :x)}}]
	$stmt paramtype x out integer 10
	puts [$stmt params]
	$stmt allrows {name barney}
    }
    -cleanup {
	if {[info exists stmt]} {
	    rename $stmt {}

!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
TDBCSTUBLIBNAME	 = tdbcstub$(TDBC_VERSION).lib
TDBC_LIB_FILE	 = tdbc$(TDBC_VERSION)$(SUFX).dll
!else
TDBCSTUBLIBNAME	 = tdbcstub.lib
TDBC_LIB_FILE	 = tcl9tdbc$(TDBC_VERSION).dll
!endif
TDBCSTUBLIB	 = $(TDBC_DIR)\win\$(BUILDDIRTOP)\$(TDBCSTUBLIBNAME)
TDBC_BIN_DIR     = $(TDBC_DIR)/win/$(BUILDDIRTOP)

PRJ_INCLUDES	= -I"$(TDBC_GENERIC_DIR)"

!if !$(STATIC_BUILD)
PRJ_LIBS  = $(TDBCSTUBLIB)
!endif

test: setup $(PROJECT)

test-jet: setup $(PROJECT)
	@echo testing tdbcodbc against Jet
	@set TDBCODBC_TYPE=jet
# the following is identical for all 3 tests
	@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
	@set TCLLIBPATH=$(OUT_DIR_PATH:\=/)
	@set TDBC_LIBRARY=$(LIBDIR:\=/)
	@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
!if $(TCLINSTALL)
	@set PATH=$(_TCLDIR)\bin;$(PATH)
	$(DEBUGGER) $(TCLSH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS)
!else
	@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
	$(DEBUGGER) $(TCLSH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) \
		-load "package ifneeded tdbc::odbc $(DOTVERSION) \
			{source {$(LIBDIR:\=/)/tdbcodbc.tcl};load {$(PRJLIB:\=/)} [string totitle $(PROJECT)]};\
		package ifneeded tdbc $(TDBC_DOTVERSION) \
			{source {$(TDBC_BIN_DIR:\=/)/tdbc.tcl};load {$(TDBC_BIN_DIR:\=/)/$(TDBC_LIB_FILE)} Tdbc}"
!endif

test-sqlserver: setup $(PROJECT)
	@echo testing tdbcodbc against SQL Server
	@set TDBCODBC_TYPE=sqlserver
# the following is identical for all 3 tests
	@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
	@set TCLLIBPATH=$(OUT_DIR_PATH:\=/)
	@set TDBC_LIBRARY=$(LIBDIR:\=/)
	@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
!if $(TCLINSTALL)
	@set PATH=$(_TCLDIR)\bin;$(PATH)
	$(DEBUGGER) $(TCLSH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS)
!else
	@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
	$(DEBUGGER) $(TCLSH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) \
		-load "package ifneeded tdbc::odbc $(DOTVERSION) \
			{source {$(LIBDIR:\=/)/tdbcodbc.tcl};load {$(PRJLIB:\=/)} [string totitle $(PROJECT)]};\
		package ifneeded tdbc $(TDBC_DOTVERSION) \
			{source {$(TDBC_BIN_DIR:\=/)/tdbc.tcl};load {$(TDBC_BIN_DIR:\=/)/$(TDBC_LIB_FILE)} Tdbc}"
!endif

test-sqlite: setup $(PROJECT)
	@echo testing tdbcodbc against SQLite
	@set TDBCODBC_TYPE=sqlite
# the following is identical for all 3 tests
	@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
	@set TCLLIBPATH=$(OUT_DIR_PATH:\=/)
	@set TDBC_LIBRARY=$(LIBDIR:\=/)
	@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
!if $(TCLINSTALL)
	@set PATH=$(_TCLDIR)\bin;$(PATH)
	$(DEBUGGER) $(TCLSH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS)
!else
	@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
	$(DEBUGGER) $(TCLSH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) \
		-load "package ifneeded tdbc::odbc $(DOTVERSION) \
			{source {$(LIBDIR:\=/)/tdbcodbc.tcl};load {$(PRJLIB:\=/)} [string totitle $(PROJECT)]};\
		package ifneeded tdbc $(TDBC_DOTVERSION) \
			{source {$(TDBC_BIN_DIR:\=/)/tdbc.tcl};load {$(TDBC_BIN_DIR:\=/)/$(TDBC_LIB_FILE)} Tdbc}"
!endif


# Explicit dependency rules
$(GENERICDIR)\tdbcodbc.c : $(TMP_DIR)\tdbcOdbcUuid.h

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>


/*
 * This library is required for x64 builds with _some_ versions of MSVC
 */
#if defined(_M_IA64) || defined(_M_AMD64)
#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")

    SetEnvironmentVariable("LINK", "");

    if (argc > 1 && *argv[1] == '-') {
	switch (*(argv[1]+1)) {
	case 'c':
	    if (argc != 3) {
		chars = snprintf(msg, sizeof(msg) - 1,
			"usage: %s -c <compiler option>\n"
			"Tests for whether cl.exe supports an option\n"
			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    }
	    return CheckForCompilerFeature(argv[2]);
	case 'l':
	    if (argc < 3) {
		chars = snprintf(msg, sizeof(msg) - 1,
			"usage: %s -l <linker option> ?<mandatory option> ...?\n"
			"Tests for whether link.exe supports an option\n"
			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    }
	    return CheckForLinkerFeature(&argv[2], argc-2);

    /*
     * Look for the commandline warning code in both streams.
     *  - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
     */

    return !(strstr(Out.buffer, "D4002") != NULL
	    || strstr(Err.buffer, "D4002") != NULL
	    || strstr(Out.buffer, "D9002") != NULL
	    || strstr(Err.buffer, "D9002") != NULL
	    || strstr(Out.buffer, "D2021") != NULL
	    || strstr(Err.buffer, "D2021") != NULL);
}

static int
CheckForLinkerFeature(
    char **options,
    int count)
{

    const char *substring)
{
    return (strstr(string, substring) != NULL);
}

/*
 * GetVersionFromFile --
 *	Looks for a match string in a file and then returns the version
 *	following the match where a version is anything acceptable to
 *	package provide or package ifneeded.
 */

static const char *
GetVersionFromFile(
    const char *filename,
    const char *match,
    int numdots)

 *	option here to handle autoconf style substitutions.
 *	The substitution file is whitespace and line delimited. The file should
 *	consist of lines matching the regular expression:
 *	  \s*\S+\s+\S*$
 *
 *	Usage is something like:
 *	  nmakehlp -S << $** > $@
 *	    @PACKAGE_NAME@ $(PACKAGE_NAME)
 *	    @PACKAGE_VERSION@ $(PACKAGE_VERSION)
 *	    <<
 */

static int
SubstituteFile(
    const char *substitutions,
    const char *filename)
{

     * 1 -> FindExSearchLimitToDirectories,
     * as these are not defined in Visual C++ 6
     */
    hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
#else
    hSearch = FindFirstFile(path, &finfo);
#endif
    if (hSearch == INVALID_HANDLE_VALUE) {
	return 1; /* Not found */
    }

    /* Loop through all subdirs checking if the keypath is under there */
    ret = 1; /* Assume not found */
    do {
	int sublen;
	/*
	 * We need to check it is a directory despite the
	 * FindExSearchLimitToDirectories in the above call. See SDK docs
	 */
	if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) {
	    continue;
	}
	sublen = strlen(finfo.cFileName);
	if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) {
	    continue;		/* Path does not fit, assume not matched */
	}
	strncpy(path+dirlen+1, finfo.cFileName, sublen);
	path[dirlen+1+sublen] = '\\';
	strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
	if (FileExists(path)) {
	    /* Found a match, print to stdout */
	    path[dirlen+1+sublen] = '\0';
	    QualifyPath(path);
	    ret = 0;
	    break;
	}
    } while (FindNextFile(hSearch, &finfo));
    FindClose(hSearch);
    return ret;
}

/*
 * LocateDependency --
 *
 *	Locates a dependency for a package.
 *	    keypath - a relative path within the package directory
 *	      that is used to confirm it is the correct directory.
 *	The search path for the package directory is currently only
 *	    the parent and grandparent of the current working directory.
 *	    If found, the command prints
 *	      name_DIRPATH=<full path of located directory>
 *	    and returns 0. If not found, does not print anything and returns 1.
 */
static int LocateDependency(const char *keypath)
{
    size_t i;
    int ret;
    static const char *paths[] = {"..", "..\\..", "..\\..\\.."};