From owner-freebsd-ports Thu Jul 13 14:50:22 2000 Delivered-To: freebsd-ports@freebsd.org Received: from freefall.freebsd.org (freefall.FreeBSD.ORG [204.216.27.21]) by hub.freebsd.org (Postfix) with ESMTP id 061DE37BD9D for ; Thu, 13 Jul 2000 14:50:01 -0700 (PDT) (envelope-from gnats@FreeBSD.org) Received: (from gnats@localhost) by freefall.freebsd.org (8.9.3/8.9.2) id OAA84809; Thu, 13 Jul 2000 14:50:00 -0700 (PDT) (envelope-from gnats@FreeBSD.org) Received: from privatecube.privatelabs.com (privatecube.privatelabs.com [198.143.31.30]) by hub.freebsd.org (Postfix) with ESMTP id D3D5037C6BA for ; Thu, 13 Jul 2000 14:49:04 -0700 (PDT) (envelope-from mi@privatelabs.com) Received: from misha.privatelabs.com (misha.privatelabs.com [198.143.31.6]) by privatecube.privatelabs.com (8.9.3/8.9.2) with ESMTP id QAA06240 for ; Thu, 13 Jul 2000 16:48:28 -0400 Received: (from mi@localhost) by misha.privatelabs.com (8.9.3/8.9.3) id RAA24261; Thu, 13 Jul 2000 17:46:47 -0400 (EDT) (envelope-from mi) Message-Id: <200007132146.RAA24261@misha.privatelabs.com> Date: Thu, 13 Jul 2000 17:46:47 -0400 (EDT) From: Mikhail Teterin Reply-To: mi@aldan.algebra.com To: FreeBSD-gnats-submit@freebsd.org X-Send-Pr-Version: 3.2 Subject: ports/19900: databases/tcl-Mysql refreshed Sender: owner-freebsd-ports@FreeBSD.ORG Precedence: bulk X-Loop: FreeBSD.org >Number: 19900 >Category: ports >Synopsis: databases/tcl-Mysql refreshed >Confidential: no >Severity: serious >Priority: medium >Responsible: freebsd-ports >State: open >Quarter: >Keywords: >Date-Required: >Class: change-request >Submitter-Id: current-users >Arrival-Date: Thu Jul 13 14:50:00 PDT 2000 >Closed-Date: >Last-Modified: >Originator: Mikhail Teterin >Release: FreeBSD 4.0-STABLE i386 >Organization: Virtual Estates, Inc. >Environment: >Description: This moves the port to use Tcl-8.3, makes the future TCL version changing easier and severely maims the sql.cc part of the software (see patch-aa) to comply with and make use of Tcl-8.x object-paradigm. The "maiming" was also submitted to the software author, which may indeed result in its inclusion in future releases. >How-To-Repeat: >Fix: --- Makefile Sun Jul 9 22:12:58 2000 +++ Makefile Thu Jul 13 17:11:34 2000 @@ -9,3 +9,3 @@ PORTVERSION= 20000114 -CATEGORIES= databases tcl82 +CATEGORIES= databases ${TCL_NODOT} MASTER_SITES= http://www.binevolve.com/~tdarugar/tcl-sql/download/ @@ -16,10 +16,13 @@ LIB_DEPENDS= mysqlclient.6:${PORTSDIR}/databases/mysql322-client -RUN_DEPENDS= tclsh8.2:${PORTSDIR}/lang/tcl82 +RUN_DEPENDS= ${TCL_VERSION:S/tcl/tclsh/}:${PORTSDIR}/lang/${TCL_NODOT} +TCL_VERSION?= tcl8.3 # Only this needs changing to switch TCL-version +TCL_NODOT= ${TCL_VERSION:S/.//} WRKSRC= ${WRKDIR}/tcl-sql/ +PLIST_SUB= TCL_VERSION=${TCL_VERSION} LIB_NAME=${LIB_NAME} do-build: - cd ${WRKSRC} && ${MAKE} PREFIX="${PREFIX}" -f ${FILESDIR}/Makefile.bsd + cd ${WRKSRC} && ${MAKE} ${PLIST_SUB} -f ${FILESDIR}/Makefile.bsd -SQL_DIR= ${PREFIX}/lib/tcl8.2/sql1.0 +SQL_DIR= ${LOCALBASE}/lib/${TCL_VERSION}/sql1.0 @@ -29,4 +32,3 @@ ${ECHO} "package ifneeded sql 1.0 \ - {load \$$tcl_library/sql1.0/`${MAKE} -f \ - ${FILESDIR}/Makefile.bsd printname` sql}" \ + {load ${SQL_DIR}/${LIB_NAME} sql}" \ > ${SQL_DIR}/pkgIndex.tcl @@ -38 +40,3 @@ .include + +LIB_NAME!= ${MAKE} -f ${FILESDIR}/Makefile.bsd printname --- files/Makefile.bsd Sun Jul 9 22:13:02 2000 +++ files/Makefile.bsd Thu Jul 13 17:15:48 2000 @@ -1 +1,3 @@ +TCL_VERSION?= tcl8.3 +TCL_NODOT?= ${TCL_VERSION:S/.//} LIB = TclMySQL @@ -5,12 +7,11 @@ SRCS = sql-mysql.cc sql.cc sql-manager.cc -CFLAGS += -I${PREFIX}/include/tcl8.2 -CFLAGS += -I${PREFIX}/include/mysql -LDADD += -L${PREFIX}/lib -ltcl82 -LDADD += -L${PREFIX}/lib/mysql -lmysqlclient +CXXFLAGS+= -I${LOCALBASE}/include/${TCL_VERSION} -DUSE_TCL_STUBS +CXXFLAGS+= -I${LOCALBASE}/include/mysql +LDADD += -L${LOCALBASE}/lib -l${TCL_NODOT:S/tcl/tclstub/} +LDADD += -L${LOCALBASE}/lib/mysql -lmysqlclient LDADD += -lgcc - -all: ${SHLIB_NAME} +INTERNALLIB= yeah, don't make the useless static lib printname: - @echo ${SHLIB_NAME} + @echo -n ${SHLIB_NAME} --- patches/patch-aa Sun Oct 31 23:15:01 1999 +++ patches/patch-aa Thu Jul 13 17:24:04 2000 @@ -1,5 +1,266 @@ ---- sql.cc.orig Fri Aug 13 15:28:56 1999 -+++ sql.cc Tue Aug 24 21:34:01 1999 -@@ -281,4 +281,4 @@ - +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,75 +93,84 @@ + 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); +- return TCL_ERROR; ++ // take care of the command: ++ if (subcommand < Disconnect && subcommand > Query) { ++ /* get the "result handle" returned previously */ ++ 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_OK; + } + } +- +- 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 +195,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 --- pkg/PLIST Sun Jul 9 22:13:02 2000 +++ pkg/PLIST Thu Jul 13 16:44:19 2000 @@ -1,4 +1,4 @@ -lib/tcl8.2/sql1.0/libTclMySQL.so.1 -lib/tcl8.2/sql1.0/pkgIndex.tcl -@dirrm lib/tcl8.2/sql1.0 +lib/%%TCL_VERSION%%/sql1.0/%%LIB_NAME%% +lib/%%TCL_VERSION%%/sql1.0/pkgIndex.tcl +@dirrm lib/%%TCL_VERSION%%/sql1.0 share/doc/tcl-MySQL/api.html >Release-Note: >Audit-Trail: >Unformatted: To Unsubscribe: send mail to majordomo@FreeBSD.org with "unsubscribe freebsd-ports" in the body of the message