freebsd-ports/databases/tcl-Mysql/files/patch-aa

This patch  substantially revamps the sql.cc  to make use of  and better
comply  with Tcl-8.x  object-paradigm. The  correct programs  will still
execute the same way, but in some erroneous cases the error messages may
be slightly different. The  patch gets rid of a lot  of sprintf and will
make your scripts faster, especially  when fetching multiple rows of the
same queries.
--- sql.cc	Fri Aug 13 15:28:56 1999
+++ sql.cc	Thu Jul 13 16:26:30 2000
@@ -12,24 +12,7 @@
 
-const char* HANDLE_PREFIX = "sql";
-const char* RESULT_PREFIX = "res";
-
-// -------------------------------------------------------------
-// Convert a tcl style connection to an interger
-// returns -1 on format error,
-int stripPrefix(char *txt, const char* prefix) {
-
-	unsigned int prefixLen = strlen(prefix);
-
-	if (strlen(txt) <= prefixLen ||
-	    strncmp(txt, prefix, prefixLen)!=0) {
-		return -1;
-	}
-	return (atoi(txt+prefixLen));
-}
-
 // -------------------------------------------------------------
-int selectdbCmd(Tcl_Interp *interp, Sql_interface *conn, char *dbname) {
+int selectdbCmd(Tcl_Interp *interp, Sql_interface *conn, Tcl_Obj *const dbname) {
 
-	if (conn->selectdb(dbname)) {
-		Tcl_SetResult(interp, dbname, TCL_VOLATILE);
+	if (conn->selectdb(Tcl_GetString(dbname))) {
+		Tcl_SetObjResult(interp, dbname);
 		return TCL_OK;
@@ -38,3 +21,3 @@
 	// An error occured.
-	Tcl_SetResult(interp, conn->getErrorMsg(), TCL_VOLATILE);
+	Tcl_SetResult(interp, conn->getErrorMsg(), TCL_STATIC);
 	return TCL_ERROR;
@@ -47,3 +30,3 @@
 	// An error occured.
-	Tcl_SetResult(interp, conn->getErrorMsg(), TCL_VOLATILE);
+	Tcl_SetResult(interp, conn->getErrorMsg(), TCL_STATIC);
 	return TCL_ERROR;
@@ -60,9 +43,9 @@
 int queryCmd(Tcl_Interp *interp, Sql_interface *conn, char *cmd) {
-	int handle = -1;
+	int handle;
 	if ((handle = conn->query(cmd)) < 0) {
 		// An error occured.
-		Tcl_SetResult(interp, conn->getErrorMsg(), TCL_VOLATILE);
+		Tcl_SetResult(interp, conn->getErrorMsg(), TCL_STATIC);
 		return TCL_ERROR;
 	}
-	sprintf(interp->result, "%s%d", RESULT_PREFIX, handle);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(handle));
 	return TCL_OK;
@@ -71,7 +54,3 @@
 // -------------------------------------------------------------
-int endqueryCmd(Tcl_Interp *interp, Sql_interface *conn, char *handle) {
-	int resHandle = 0;
-	if (handle) {
-		resHandle = stripPrefix(handle, RESULT_PREFIX);
-	}
+int endqueryCmd(Tcl_Interp *interp, Sql_interface *conn, int resHandle) {
 	conn->endquery(resHandle);
@@ -81,14 +60,4 @@
 // -------------------------------------------------------------
-int numrowsCmd(Tcl_Interp *interp, Sql_interface *conn, char *handle) {
-	int resHandle = 0;
-	if (handle) {
-		resHandle = stripPrefix(handle, RESULT_PREFIX);
-	}
-	int nrows = conn->numRows(resHandle);
-
-	// Return the result of the command:
-	char retval[20];
-	sprintf(retval, "%d", nrows);
-
-	Tcl_SetResult(interp, retval, TCL_VOLATILE);
+int numrowsCmd(Tcl_Interp *interp, Sql_interface *conn, int resHandle) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(conn->numRows(resHandle)));
 	return TCL_OK;
@@ -97,13 +66,3 @@
 // -------------------------------------------------------------
-int fetchrowCmd(Tcl_Interp *interp, Sql_interface *conn, char *handle) {
-
-	int resHandle = 0;
-	if (handle) {
-		resHandle = stripPrefix(handle, RESULT_PREFIX);
-	}
-	if (resHandle < 0) {
-		Tcl_SetResult(interp, "Invalid result handle.", TCL_VOLATILE);
-		return TCL_ERROR;
-	}
-
+int fetchrowCmd(Tcl_Interp *interp, Sql_interface *conn, int resHandle) {
 	Sql_row *row;
@@ -124,6 +83,7 @@
 //
-int SqlCmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) 
+int SqlCmd(ClientData clientData, Tcl_Interp *interp,
+	int objc, Tcl_Obj * const objv[]) 
 {
-	if (argc == 1) {
-		Tcl_SetResult(interp, "Usage: sql command ?handle?", TCL_STATIC);
+	if (objc == 1) {
+		Tcl_WrongNumArgs(interp, 1, objv, "command ?handle?");
 		return TCL_ERROR;
@@ -133,58 +93,58 @@
 	Manager_sql *mgr = (Manager_sql *)clientData;
-	int res = TCL_OK;
+	int res;
 
-	int c = -1;
+	int connid;
 
-	// -----------------------------------
-	if (strcmp(argv[1], "connect")==0) {
-		c = mgr->connect(argc-2, argv+2);
-		if (c < 0) {
-			char *basemsg = "Unable to Connect: ";
-			char *errmsg = mgr->getErrorMsg();
-			char *msg = Tcl_Alloc(strlen(errmsg)+strlen(basemsg));
-			strcpy(msg, basemsg);
-			strcat(msg, errmsg);
-			Tcl_SetResult(interp, msg, TCL_DYNAMIC);
+	static char *subCmds[] = {
+		"exec", "query", "endquery", "fetchrow",
+		"numrows", "disconnect", "selectdb", "connect",
+		(char *)NULL
+	};
+	enum e_subcommands {
+		Execute, Query, EndQuery, FetchRow,
+		NumRows, Disconnect, SelectDB, Connect
+	} subcommand;
+	if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "subcommand", 0,
+			(int *) &subcommand) != TCL_OK) return TCL_ERROR;
+	if (subcommand == Connect) {
+		char *argv[objc-2];
+		for (res = 0; res < objc-2; res++) {
+			argv[res] = Tcl_GetString(objv[res+2]);
+		}
+		connid = mgr->connect(objc-2, argv);
+		if (connid < 0) {
+			Tcl_SetResult(interp, mgr->getErrorMsg(), TCL_STATIC);
 			return TCL_ERROR;
 		}
-		char errormsg[16];
-		sprintf(errormsg, "%s%d", HANDLE_PREFIX, c);
-		Tcl_SetResult(interp,errormsg,TCL_VOLATILE);
-		/* sprintf(interp->result, "%s%d", HANDLE_PREFIX, c); */
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(connid));
 		return TCL_OK;
+	}
 
-	} else {
-
-		// Every other command needs a handle. Get it.
-		int connid = -1;
-		if (argc <= 2) {
-			Tcl_SetResult(interp, "Usage:\nsql command handle", TCL_STATIC);
-			return TCL_ERROR;
-		} else if ((connid = stripPrefix(argv[2], HANDLE_PREFIX)) < 0) {
-			Tcl_AppendResult(interp, "sql: Invalid handle: ", argv[2], NULL);
-			return TCL_ERROR;
-		} else if (!mgr->inUse(connid)) {
-			// This connection is not currently being used
-			Tcl_AppendResult(interp, "sql: not connected on handle ", argv[2], NULL);
-			return TCL_ERROR;
-		}
-		Sql_interface *conn = mgr->connection(connid);
+	// Every other command needs a handle. Get it.
+	if (objc <= 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, "handle");
+		return TCL_ERROR;
+	} else if (Tcl_GetIntFromObj(NULL, objv[2], &connid)
+				!= TCL_OK || connid < 0) {
+		Tcl_SetObjResult(interp, objv[2]);
+		Tcl_AppendResult(interp, ": invalid handle", NULL);
+		return TCL_ERROR;
+	} else if (!mgr->inUse(connid)) {
+		// This connection is not currently being used
+		Tcl_SetObjResult(interp, objv[2]);
+		Tcl_AppendResult(interp, ": not connected on "
+			"this handle", NULL);
+		return TCL_ERROR;
+	}
+	Sql_interface *conn = mgr->connection(connid);
 
-		// take care of the command:
-		if (strcmp(argv[1], "exec") == 0) {
-			res = execCmd(interp, conn, argv[3]);
-		} else if (strcmp(argv[1], "query") == 0) {
-			res = queryCmd(interp, conn, argv[3]);
-		} else if (strcmp(argv[1], "endquery") == 0) {
-			res = endqueryCmd(interp, conn, argv[3]);
-		} else if (strcmp(argv[1], "fetchrow") == 0) {
-			res = fetchrowCmd(interp, conn, argv[3]);
-		} else if (strcmp(argv[1], "numrows") == 0) {
-			res = numrowsCmd(interp, conn, argv[3]);
-		} else if (strcmp(argv[1], "disconnect") == 0) {
-			res = disconnectCmd(interp, mgr, connid);
-		} else if (strcmp(argv[1], "selectdb")==0) {
-			res = selectdbCmd(interp, conn, argv[3]);
-		} else {
-			Tcl_AppendResult(interp, "sql: unknown sql command: ", argv[1], NULL);
+	// take care of the command:
+	if (subcommand < Disconnect && subcommand > Query) {
+		/* get the "result handle" returned previously */
+		if (objc < 4) res = 0; /* oddly, this is how it was -- bug? */
+		else if (Tcl_GetIntFromObj(NULL, objv[3], &res) != TCL_OK ||
+				res < 0) {
+			Tcl_SetObjResult(interp, objv[3]);
+			Tcl_AppendResult(interp, ": invalid result"
+				" handle", NULL);
 			return TCL_ERROR;
@@ -192,16 +152,26 @@
 	}
-	
-	return res;
-
+	switch (subcommand) {
+		case Execute:
+			return execCmd(interp, conn, Tcl_GetString(objv[3]));
+		case Query:
+			return queryCmd(interp, conn, Tcl_GetString(objv[3]));
+		case EndQuery:
+			return endqueryCmd(interp, conn, res);
+		case FetchRow:
+			return fetchrowCmd(interp, conn, res);
+		case NumRows:
+			return numrowsCmd(interp, conn, res);
+		case Disconnect:
+			return disconnectCmd(interp, mgr, connid);
+		case SelectDB:
+			return selectdbCmd(interp, conn, objv[3]);
+		/* default not needed -- handled by Tcl_GetIndexFromObj *\
+		\* if you suspect a programming error -- uncomment:     */
 #if 0
-	// Return the result of the command:
-	char returnValue[10];
-	sprintf(returnValue, "%d", c);
-
-	// The TCL_VOLATILE means the memory for our returnValue was allocated
-	// from the stack. See Tcl_SetResult for details.
-	Tcl_SetResult(interp, returnValue, TCL_VOLATILE);
-
-	return TCL_OK;
+		default:
+			Tcl_SetResult(interp, "this is not reachable",
+				TCL_STATIC);
 #endif
+	}
+	return TCL_ERROR; /* not reachable */
 }
@@ -226,7 +196,7 @@
 
-	Tcl_CreateCommand (interp, "sql", SqlCmd ,(ClientData) s,
-										 (Tcl_CmdDeleteProc*) NULL);
+	Tcl_CreateObjCommand (interp, "sql", SqlCmd, (ClientData)s,
+		 (Tcl_CmdDeleteProc*) NULL);
 
-	// Provide a package called Sample 
-	if (Tcl_PkgProvide(interp, "Sql", "1.0") == TCL_ERROR)
+	// Provide a package called ``sql'' 
+	if (Tcl_PkgProvide(interp, "sql", "1.1") == TCL_ERROR)
 		return TCL_ERROR;