mirror of
https://git.FreeBSD.org/ports.git
synced 2024-11-23 00:43:28 +00:00
Update to use tcl-8.3.
PR: 19900 Submitted by: maintainer
This commit is contained in:
parent
e76c214557
commit
a46043fd14
Notes:
svn2git
2021-03-31 03:12:20 +00:00
svn path=/head/; revision=30713
@ -7,28 +7,30 @@
|
||||
|
||||
PORTNAME= tcl-sql
|
||||
PORTVERSION= 20000114
|
||||
CATEGORIES= databases tcl82
|
||||
CATEGORIES= databases ${TCL_NODOT}
|
||||
MASTER_SITES= http://www.binevolve.com/~tdarugar/tcl-sql/download/
|
||||
EXTRACT_SUFX= .tgz
|
||||
|
||||
MAINTAINER= mi@aldan.algebra.com
|
||||
|
||||
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
|
||||
|
||||
do-install:
|
||||
${MKDIR} ${SQL_DIR}
|
||||
${INSTALL_DATA} ${WRKSRC}/obj/libTclMySQL.so.* ${SQL_DIR}
|
||||
${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
|
||||
.if !defined(NOPORTDOCS)
|
||||
${MKDIR} ${PREFIX}/share/doc/tcl-MySQL/
|
||||
@ -36,3 +38,5 @@ do-install:
|
||||
.endif
|
||||
|
||||
.include <bsd.port.mk>
|
||||
|
||||
LIB_NAME!= ${MAKE} -f ${FILESDIR}/Makefile.bsd printname
|
||||
|
@ -1,17 +1,18 @@
|
||||
TCL_VERSION?= tcl8.3
|
||||
TCL_NODOT?= ${TCL_VERSION:S/.//}
|
||||
LIB = TclMySQL
|
||||
SHLIB_MAJOR= 1
|
||||
SHLIB_MINOR= 0
|
||||
|
||||
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}
|
||||
|
||||
.include <bsd.lib.mk>
|
||||
|
@ -1,7 +1,268 @@
|
||||
--- 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
|
||||
- if (Tcl_PkgProvide(interp, "Sql", "1.0") == TCL_ERROR)
|
||||
+ // Provide a package called ``sql''
|
||||
|
@ -1,6 +1,6 @@
|
||||
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
|
||||
share/doc/tcl-MySQL/sample.full.txt
|
||||
share/doc/tcl-MySQL/sample.simple.txt
|
||||
|
Loading…
Reference in New Issue
Block a user