cpet/freebsd-ports
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update to use tcl-8.3.

Browse Source 
PR:		19900
Submitted by:	maintainer
This commit is contained in:
Steve Price 2000-07-16 19:51:40 +00:00
parent e76c214557
commit a46043fd14
Notes: svn2git 2021-03-31 03:12:20 +00:00 
svn path=/head/; revision=30713
4 changed files with 286 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
databases/tcl-Mysql/Makefile
View File

@ -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

15
databases/tcl-Mysql/files/Makefile.bsd
View File

@ -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>

269
databases/tcl-Mysql/files/patch-aa
View File

@ -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''

6
databases/tcl-Mysql/pkg-plist
View File

@ -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