Date: Thu, 13 Jul 2000 17:46:47 -0400 (EDT) From: Mikhail Teterin <mi@privatelabs.com> To: FreeBSD-gnats-submit@freebsd.org Subject: ports/19900: databases/tcl-Mysql refreshed Message-ID: <200007132146.RAA24261@misha.privatelabs.com>
next in thread | raw e-mail | index | archive | help
>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 <bsd.port.mk>
+
+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
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?200007132146.RAA24261>