blob: 466a78941da05ffb5782ee647bc036be64a3fa61 [file] [log] [blame]
drh75897232000-05-29 14:26:00 +00001/*
drhb19a2bc2001-09-16 00:13:26 +00002** 2001 September 15
drh75897232000-05-29 14:26:00 +00003**
drhb19a2bc2001-09-16 00:13:26 +00004** The author disclaims copyright to this source code. In place of
5** a legal notice, here is a blessing:
drh75897232000-05-29 14:26:00 +00006**
drhb19a2bc2001-09-16 00:13:26 +00007** May you do good and not evil.
8** May you find forgiveness for yourself and forgive others.
9** May you share freely, never taking more than you give.
drh75897232000-05-29 14:26:00 +000010**
11*************************************************************************
12** A TCL Interface to SQLite
13**
drh704027f2002-07-15 20:58:47 +000014** $Id: tclsqlite.c,v 1.39 2002/07/15 20:58:48 drh Exp $
drh75897232000-05-29 14:26:00 +000015*/
drh6d313162000-09-21 13:01:35 +000016#ifndef NO_TCL /* Omit this whole file if TCL is unavailable */
17
drh06b27182002-06-26 20:06:05 +000018#include "sqliteInt.h"
drh17a68932001-01-31 13:28:08 +000019#include "tcl.h"
drh75897232000-05-29 14:26:00 +000020#include <stdlib.h>
21#include <string.h>
drhce927062001-11-09 13:41:09 +000022#include <assert.h>
drh75897232000-05-29 14:26:00 +000023
24/*
drh98808ba2001-10-18 12:34:46 +000025** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we
26** have to do a translation when going between the two. Set the
27** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
28** this translation.
29*/
30#if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)
31# define UTF_TRANSLATION_NEEDED 1
32#endif
33
34/*
drhbec3f402000-08-04 13:49:02 +000035** There is one instance of this structure for each SQLite database
36** that has been opened by the SQLite TCL interface.
37*/
38typedef struct SqliteDb SqliteDb;
39struct SqliteDb {
40 sqlite *db; /* The "real" database structure */
41 Tcl_Interp *interp; /* The interpreter used for this database */
drh6d313162000-09-21 13:01:35 +000042 char *zBusy; /* The busy callback routine */
drhbec3f402000-08-04 13:49:02 +000043};
44
45/*
drh75897232000-05-29 14:26:00 +000046** An instance of this structure passes information thru the sqlite
47** logic from the original TCL command into the callback routine.
48*/
49typedef struct CallbackData CallbackData;
50struct CallbackData {
51 Tcl_Interp *interp; /* The TCL interpreter */
52 char *zArray; /* The array into which data is written */
drh6d313162000-09-21 13:01:35 +000053 Tcl_Obj *pCode; /* The code to execute for each row */
drhce927062001-11-09 13:41:09 +000054 int once; /* Set for first callback only */
drh960e8c62001-04-03 16:53:21 +000055 int tcl_rc; /* Return code from TCL script */
drh98808ba2001-10-18 12:34:46 +000056 int nColName; /* Number of entries in the azColName[] array */
57 char **azColName; /* Column names translated to UTF-8 */
drh98808ba2001-10-18 12:34:46 +000058};
drh297ecf12001-04-05 15:57:13 +000059
drh6d4abfb2001-10-22 02:58:08 +000060#ifdef UTF_TRANSLATION_NEEDED
drh297ecf12001-04-05 15:57:13 +000061/*
drh75897232000-05-29 14:26:00 +000062** Called for each row of the result.
drh6d4abfb2001-10-22 02:58:08 +000063**
64** This version is used when TCL expects UTF-8 data but the database
65** uses the ISO8859 format. A translation must occur from ISO8859 into
66** UTF-8.
drh75897232000-05-29 14:26:00 +000067*/
68static int DbEvalCallback(
69 void *clientData, /* An instance of CallbackData */
70 int nCol, /* Number of columns in the result */
71 char ** azCol, /* Data for each column */
72 char ** azN /* Name for each column */
73){
74 CallbackData *cbData = (CallbackData*)clientData;
75 int i, rc;
drh297ecf12001-04-05 15:57:13 +000076 Tcl_DString dCol;
drh6d4abfb2001-10-22 02:58:08 +000077 Tcl_DStringInit(&dCol);
drhce927062001-11-09 13:41:09 +000078 if( cbData->azColName==0 ){
79 assert( cbData->once );
80 cbData->once = 0;
81 if( cbData->zArray[0] ){
82 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
drh6d4abfb2001-10-22 02:58:08 +000083 }
drhce927062001-11-09 13:41:09 +000084 cbData->azColName = malloc( nCol*sizeof(char*) );
85 if( cbData->azColName==0 ){ return 1; }
drh6d4abfb2001-10-22 02:58:08 +000086 cbData->nColName = nCol;
87 for(i=0; i<nCol; i++){
88 Tcl_ExternalToUtfDString(NULL, azN[i], -1, &dCol);
drhce927062001-11-09 13:41:09 +000089 cbData->azColName[i] = malloc( Tcl_DStringLength(&dCol) + 1 );
90 if( cbData->azColName[i] ){
91 strcpy(cbData->azColName[i], Tcl_DStringValue(&dCol));
92 }else{
93 return 1;
drh6d4abfb2001-10-22 02:58:08 +000094 }
drhce927062001-11-09 13:41:09 +000095 if( cbData->zArray[0] ){
96 Tcl_SetVar2(cbData->interp, cbData->zArray, "*",
97 Tcl_DStringValue(&dCol), TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
drh704027f2002-07-15 20:58:47 +000098 if( azN[nCol]!=0 ){
drh5080aaa2002-07-11 12:18:16 +000099 Tcl_DString dType;
100 Tcl_DStringInit(&dType);
101 Tcl_DStringAppend(&dType, "typeof:", -1);
102 Tcl_DStringAppend(&dType, Tcl_DStringValue(&dCol), -1);
103 Tcl_DStringFree(&dCol);
104 Tcl_ExternalToUtfDString(NULL, azN[i+nCol], -1, &dCol);
105 Tcl_SetVar2(cbData->interp, cbData->zArray,
106 Tcl_DStringValue(&dType), Tcl_DStringValue(&dCol),
107 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
108 Tcl_DStringFree(&dType);
109 }
drhce927062001-11-09 13:41:09 +0000110 }
drhfa173a72002-07-10 21:26:00 +0000111
drh6d4abfb2001-10-22 02:58:08 +0000112 Tcl_DStringFree(&dCol);
113 }
drh6d4abfb2001-10-22 02:58:08 +0000114 }
115 if( azCol!=0 ){
116 if( cbData->zArray[0] ){
117 for(i=0; i<nCol; i++){
118 char *z = azCol[i];
119 if( z==0 ) z = "";
120 Tcl_DStringInit(&dCol);
121 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
122 Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i],
123 Tcl_DStringValue(&dCol), 0);
124 Tcl_DStringFree(&dCol);
125 }
126 }else{
127 for(i=0; i<nCol; i++){
128 char *z = azCol[i];
129 if( z==0 ) z = "";
130 Tcl_DStringInit(&dCol);
131 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
132 Tcl_SetVar(cbData->interp, cbData->azColName[i],
133 Tcl_DStringValue(&dCol), 0);
134 Tcl_DStringFree(&dCol);
135 }
136 }
137 }
138 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
139 if( rc==TCL_CONTINUE ) rc = TCL_OK;
140 cbData->tcl_rc = rc;
141 return rc!=TCL_OK;
142}
143#endif /* UTF_TRANSLATION_NEEDED */
144
145#ifndef UTF_TRANSLATION_NEEDED
146/*
147** Called for each row of the result.
148**
149** This version is used when either of the following is true:
150**
151** (1) This version of TCL uses UTF-8 and the data in the
152** SQLite database is already in the UTF-8 format.
153**
154** (2) This version of TCL uses ISO8859 and the data in the
155** SQLite database is already in the ISO8859 format.
156*/
157static int DbEvalCallback(
158 void *clientData, /* An instance of CallbackData */
159 int nCol, /* Number of columns in the result */
160 char ** azCol, /* Data for each column */
161 char ** azN /* Name for each column */
162){
163 CallbackData *cbData = (CallbackData*)clientData;
164 int i, rc;
drh6a535342001-10-19 16:44:56 +0000165 if( azCol==0 || (cbData->once && cbData->zArray[0]) ){
166 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
167 for(i=0; i<nCol; i++){
168 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", azN[i],
169 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
drh5080aaa2002-07-11 12:18:16 +0000170 if( azN[nCol] ){
171 char *z = sqlite_mprintf("typeof:%s", azN[i]);
172 Tcl_SetVar2(cbData->interp, cbData->zArray, z, azN[i+nCol],
173 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
174 sqlite_freemem(z);
175 }
drh6a535342001-10-19 16:44:56 +0000176 }
177 cbData->once = 0;
178 }
179 if( azCol!=0 ){
180 if( cbData->zArray[0] ){
drh75897232000-05-29 14:26:00 +0000181 for(i=0; i<nCol; i++){
drh6a535342001-10-19 16:44:56 +0000182 char *z = azCol[i];
183 if( z==0 ) z = "";
drh6a535342001-10-19 16:44:56 +0000184 Tcl_SetVar2(cbData->interp, cbData->zArray, azN[i], z, 0);
drh6a535342001-10-19 16:44:56 +0000185 }
186 }else{
187 for(i=0; i<nCol; i++){
188 char *z = azCol[i];
189 if( z==0 ) z = "";
drh6a535342001-10-19 16:44:56 +0000190 Tcl_SetVar(cbData->interp, azN[i], z, 0);
drh75897232000-05-29 14:26:00 +0000191 }
192 }
drh75897232000-05-29 14:26:00 +0000193 }
drh6d313162000-09-21 13:01:35 +0000194 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
drh960e8c62001-04-03 16:53:21 +0000195 if( rc==TCL_CONTINUE ) rc = TCL_OK;
196 cbData->tcl_rc = rc;
197 return rc!=TCL_OK;
drh75897232000-05-29 14:26:00 +0000198}
drh6d4abfb2001-10-22 02:58:08 +0000199#endif
drh75897232000-05-29 14:26:00 +0000200
201/*
drh6d313162000-09-21 13:01:35 +0000202** This is an alternative callback for database queries. Instead
203** of invoking a TCL script to handle the result, this callback just
204** appends each column of the result to a list. After the query
205** is complete, the list is returned.
206*/
207static int DbEvalCallback2(
208 void *clientData, /* An instance of CallbackData */
209 int nCol, /* Number of columns in the result */
210 char ** azCol, /* Data for each column */
211 char ** azN /* Name for each column */
212){
213 Tcl_Obj *pList = (Tcl_Obj*)clientData;
214 int i;
drh6a535342001-10-19 16:44:56 +0000215 if( azCol==0 ) return 0;
drh6d313162000-09-21 13:01:35 +0000216 for(i=0; i<nCol; i++){
217 Tcl_Obj *pElem;
218 if( azCol[i] && *azCol[i] ){
drh297ecf12001-04-05 15:57:13 +0000219#ifdef UTF_TRANSLATION_NEEDED
220 Tcl_DString dCol;
221 Tcl_DStringInit(&dCol);
222 Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol);
223 pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
224 Tcl_DStringFree(&dCol);
225#else
drh6d313162000-09-21 13:01:35 +0000226 pElem = Tcl_NewStringObj(azCol[i], -1);
drh297ecf12001-04-05 15:57:13 +0000227#endif
drh6d313162000-09-21 13:01:35 +0000228 }else{
229 pElem = Tcl_NewObj();
230 }
231 Tcl_ListObjAppendElement(0, pList, pElem);
232 }
233 return 0;
234}
235
236/*
drh75897232000-05-29 14:26:00 +0000237** Called when the command is deleted.
238*/
239static void DbDeleteCmd(void *db){
drhbec3f402000-08-04 13:49:02 +0000240 SqliteDb *pDb = (SqliteDb*)db;
241 sqlite_close(pDb->db);
242 if( pDb->zBusy ){
243 Tcl_Free(pDb->zBusy);
244 }
245 Tcl_Free((char*)pDb);
246}
247
248/*
249** This routine is called when a database file is locked while trying
250** to execute SQL.
251*/
252static int DbBusyHandler(void *cd, const char *zTable, int nTries){
253 SqliteDb *pDb = (SqliteDb*)cd;
254 int rc;
255 char zVal[30];
256 char *zCmd;
drhbec3f402000-08-04 13:49:02 +0000257 Tcl_DString cmd;
258
259 Tcl_DStringInit(&cmd);
260 Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
261 Tcl_DStringAppendElement(&cmd, zTable);
262 sprintf(zVal, " %d", nTries);
263 Tcl_DStringAppend(&cmd, zVal, -1);
264 zCmd = Tcl_DStringValue(&cmd);
265 rc = Tcl_Eval(pDb->interp, zCmd);
266 Tcl_DStringFree(&cmd);
267 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
268 return 0;
269 }
270 return 1;
drh75897232000-05-29 14:26:00 +0000271}
272
273/*
274** The "sqlite" command below creates a new Tcl command for each
275** connection it opens to an SQLite database. This routine is invoked
276** whenever one of those connection-specific commands is executed
277** in Tcl. For example, if you run Tcl code like this:
278**
279** sqlite db1 "my_database"
280** db1 close
281**
282** The first command opens a connection to the "my_database" database
283** and calls that connection "db1". The second command causes this
284** subroutine to be invoked.
285*/
drh6d313162000-09-21 13:01:35 +0000286static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
drhbec3f402000-08-04 13:49:02 +0000287 SqliteDb *pDb = (SqliteDb*)cd;
drh6d313162000-09-21 13:01:35 +0000288 int choice;
drh0de8c112002-07-06 16:32:14 +0000289 static const char *DB_strs[] = {
drh411995d2002-06-25 19:31:18 +0000290 "busy", "changes", "close",
291 "complete", "eval", "last_insert_rowid",
292 "open_aux_file", "timeout", 0
drh6d313162000-09-21 13:01:35 +0000293 };
drh411995d2002-06-25 19:31:18 +0000294 enum DB_enum {
295 DB_BUSY, DB_CHANGES, DB_CLOSE,
296 DB_COMPLETE, DB_EVAL, DB_LAST_INSERT_ROWID,
297 DB_OPEN_AUX_FILE, DB_TIMEOUT,
drh6d313162000-09-21 13:01:35 +0000298 };
299
300 if( objc<2 ){
301 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
drh75897232000-05-29 14:26:00 +0000302 return TCL_ERROR;
303 }
drh411995d2002-06-25 19:31:18 +0000304 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
drh6d313162000-09-21 13:01:35 +0000305 return TCL_ERROR;
306 }
307
drh411995d2002-06-25 19:31:18 +0000308 switch( (enum DB_enum)choice ){
drh75897232000-05-29 14:26:00 +0000309
drhbec3f402000-08-04 13:49:02 +0000310 /* $db busy ?CALLBACK?
311 **
312 ** Invoke the given callback if an SQL statement attempts to open
313 ** a locked database file.
314 */
drh6d313162000-09-21 13:01:35 +0000315 case DB_BUSY: {
316 if( objc>3 ){
317 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
drhbec3f402000-08-04 13:49:02 +0000318 return TCL_ERROR;
drh6d313162000-09-21 13:01:35 +0000319 }else if( objc==2 ){
drhbec3f402000-08-04 13:49:02 +0000320 if( pDb->zBusy ){
321 Tcl_AppendResult(interp, pDb->zBusy, 0);
322 }
323 }else{
drh6d313162000-09-21 13:01:35 +0000324 char *zBusy;
325 int len;
drhbec3f402000-08-04 13:49:02 +0000326 if( pDb->zBusy ){
327 Tcl_Free(pDb->zBusy);
drhbec3f402000-08-04 13:49:02 +0000328 }
drh6d313162000-09-21 13:01:35 +0000329 zBusy = Tcl_GetStringFromObj(objv[2], &len);
330 if( zBusy && len>0 ){
331 pDb->zBusy = Tcl_Alloc( len + 1 );
332 strcpy(pDb->zBusy, zBusy);
333 }else{
334 pDb->zBusy = 0;
drhbec3f402000-08-04 13:49:02 +0000335 }
336 if( pDb->zBusy ){
337 pDb->interp = interp;
338 sqlite_busy_handler(pDb->db, DbBusyHandler, pDb);
drh6d313162000-09-21 13:01:35 +0000339 }else{
340 sqlite_busy_handler(pDb->db, 0, 0);
drhbec3f402000-08-04 13:49:02 +0000341 }
342 }
drh6d313162000-09-21 13:01:35 +0000343 break;
344 }
drhbec3f402000-08-04 13:49:02 +0000345
drhc8d30ac2002-04-12 10:08:59 +0000346 /*
347 ** $db changes
348 **
349 ** Return the number of rows that were modified, inserted, or deleted by
350 ** the most recent "eval".
351 */
352 case DB_CHANGES: {
353 Tcl_Obj *pResult;
354 int nChange;
355 if( objc!=2 ){
356 Tcl_WrongNumArgs(interp, 2, objv, "");
357 return TCL_ERROR;
358 }
359 nChange = sqlite_changes(pDb->db);
360 pResult = Tcl_GetObjResult(interp);
361 Tcl_SetIntObj(pResult, nChange);
362 break;
363 }
364
drh75897232000-05-29 14:26:00 +0000365 /* $db close
366 **
367 ** Shutdown the database
368 */
drh6d313162000-09-21 13:01:35 +0000369 case DB_CLOSE: {
370 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
371 break;
372 }
drh75897232000-05-29 14:26:00 +0000373
374 /* $db complete SQL
375 **
376 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
377 ** additional lines of input are needed. This is similar to the
378 ** built-in "info complete" command of Tcl.
379 */
drh6d313162000-09-21 13:01:35 +0000380 case DB_COMPLETE: {
381 Tcl_Obj *pResult;
382 int isComplete;
383 if( objc!=3 ){
384 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
drh75897232000-05-29 14:26:00 +0000385 return TCL_ERROR;
386 }
drh6d313162000-09-21 13:01:35 +0000387 isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) );
388 pResult = Tcl_GetObjResult(interp);
389 Tcl_SetBooleanObj(pResult, isComplete);
390 break;
391 }
drh75897232000-05-29 14:26:00 +0000392
393 /*
394 ** $db eval $sql ?array { ...code... }?
395 **
396 ** The SQL statement in $sql is evaluated. For each row, the values are
drhbec3f402000-08-04 13:49:02 +0000397 ** placed in elements of the array named "array" and ...code... is executed.
drh75897232000-05-29 14:26:00 +0000398 ** If "array" and "code" are omitted, then no callback is every invoked.
399 ** If "array" is an empty string, then the values are placed in variables
400 ** that have the same name as the fields extracted by the query.
401 */
drh6d313162000-09-21 13:01:35 +0000402 case DB_EVAL: {
drh75897232000-05-29 14:26:00 +0000403 CallbackData cbData;
404 char *zErrMsg;
drh6d313162000-09-21 13:01:35 +0000405 char *zSql;
drh75897232000-05-29 14:26:00 +0000406 int rc;
drh297ecf12001-04-05 15:57:13 +0000407#ifdef UTF_TRANSLATION_NEEDED
408 Tcl_DString dSql;
drh6d4abfb2001-10-22 02:58:08 +0000409 int i;
drh297ecf12001-04-05 15:57:13 +0000410#endif
drh75897232000-05-29 14:26:00 +0000411
drh6d313162000-09-21 13:01:35 +0000412 if( objc!=5 && objc!=3 ){
413 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?");
drh75897232000-05-29 14:26:00 +0000414 return TCL_ERROR;
415 }
drhbec3f402000-08-04 13:49:02 +0000416 pDb->interp = interp;
drh6d313162000-09-21 13:01:35 +0000417 zSql = Tcl_GetStringFromObj(objv[2], 0);
drh297ecf12001-04-05 15:57:13 +0000418#ifdef UTF_TRANSLATION_NEEDED
419 Tcl_DStringInit(&dSql);
420 Tcl_UtfToExternalDString(NULL, zSql, -1, &dSql);
421 zSql = Tcl_DStringValue(&dSql);
422#endif
drh6d313162000-09-21 13:01:35 +0000423 Tcl_IncrRefCount(objv[2]);
424 if( objc==5 ){
drh75897232000-05-29 14:26:00 +0000425 cbData.interp = interp;
drhdcc581c2000-05-30 13:44:19 +0000426 cbData.once = 1;
drh6d313162000-09-21 13:01:35 +0000427 cbData.zArray = Tcl_GetStringFromObj(objv[3], 0);
428 cbData.pCode = objv[4];
drh960e8c62001-04-03 16:53:21 +0000429 cbData.tcl_rc = TCL_OK;
drh6d4abfb2001-10-22 02:58:08 +0000430 cbData.nColName = 0;
431 cbData.azColName = 0;
drh75897232000-05-29 14:26:00 +0000432 zErrMsg = 0;
drh6d313162000-09-21 13:01:35 +0000433 Tcl_IncrRefCount(objv[3]);
434 Tcl_IncrRefCount(objv[4]);
435 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg);
436 Tcl_DecrRefCount(objv[4]);
437 Tcl_DecrRefCount(objv[3]);
drh960e8c62001-04-03 16:53:21 +0000438 if( cbData.tcl_rc==TCL_BREAK ){ cbData.tcl_rc = TCL_OK; }
drh75897232000-05-29 14:26:00 +0000439 }else{
drh6d313162000-09-21 13:01:35 +0000440 Tcl_Obj *pList = Tcl_NewObj();
drh960e8c62001-04-03 16:53:21 +0000441 cbData.tcl_rc = TCL_OK;
drh6d313162000-09-21 13:01:35 +0000442 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg);
443 Tcl_SetObjResult(interp, pList);
drh75897232000-05-29 14:26:00 +0000444 }
445 if( zErrMsg ){
446 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
447 free(zErrMsg);
drh960e8c62001-04-03 16:53:21 +0000448 rc = TCL_ERROR;
drh6d4abfb2001-10-22 02:58:08 +0000449 }else if( rc!=SQLITE_OK && rc!=SQLITE_ABORT ){
450 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
451 rc = TCL_ERROR;
drh960e8c62001-04-03 16:53:21 +0000452 }else{
453 rc = cbData.tcl_rc;
drh75897232000-05-29 14:26:00 +0000454 }
drh6d313162000-09-21 13:01:35 +0000455 Tcl_DecrRefCount(objv[2]);
drh297ecf12001-04-05 15:57:13 +0000456#ifdef UTF_TRANSLATION_NEEDED
457 Tcl_DStringFree(&dSql);
drh6d4abfb2001-10-22 02:58:08 +0000458 if( objc==5 && cbData.azColName ){
459 for(i=0; i<cbData.nColName; i++){
460 if( cbData.azColName[i] ) free(cbData.azColName[i]);
461 }
462 free(cbData.azColName);
drhce927062001-11-09 13:41:09 +0000463 cbData.azColName = 0;
drh6d4abfb2001-10-22 02:58:08 +0000464 }
drh297ecf12001-04-05 15:57:13 +0000465#endif
drh75897232000-05-29 14:26:00 +0000466 return rc;
drh6d313162000-09-21 13:01:35 +0000467 }
drhbec3f402000-08-04 13:49:02 +0000468
469 /*
drhaf9ff332002-01-16 21:00:27 +0000470 ** $db last_insert_rowid
471 **
472 ** Return an integer which is the ROWID for the most recent insert.
473 */
474 case DB_LAST_INSERT_ROWID: {
475 Tcl_Obj *pResult;
476 int rowid;
477 if( objc!=2 ){
478 Tcl_WrongNumArgs(interp, 2, objv, "");
479 return TCL_ERROR;
480 }
481 rowid = sqlite_last_insert_rowid(pDb->db);
482 pResult = Tcl_GetObjResult(interp);
483 Tcl_SetIntObj(pResult, rowid);
484 break;
485 }
486
487 /*
drh411995d2002-06-25 19:31:18 +0000488 ** $db open_aux_file FILENAME
489 **
490 ** Begin using FILENAME as the database file used to store temporary
491 ** tables.
492 */
493 case DB_OPEN_AUX_FILE: {
494 const char *zFilename;
495 char *zErrMsg = 0;
496 int rc;
497 if( objc!=3 ){
498 Tcl_WrongNumArgs(interp, 2, objv, "FILENAME");
499 return TCL_ERROR;
500 }
501 zFilename = Tcl_GetStringFromObj(objv[2], 0);
502 rc = sqlite_open_aux_file(pDb->db, zFilename, &zErrMsg);
503 if( rc!=0 ){
504 if( zErrMsg ){
505 Tcl_AppendResult(interp, zErrMsg, 0);
506 free(zErrMsg);
507 }else{
508 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
509 }
510 return TCL_ERROR;
511 }
512 break;
513 }
514
515 /*
drhbec3f402000-08-04 13:49:02 +0000516 ** $db timeout MILLESECONDS
517 **
518 ** Delay for the number of milliseconds specified when a file is locked.
519 */
drh6d313162000-09-21 13:01:35 +0000520 case DB_TIMEOUT: {
drhbec3f402000-08-04 13:49:02 +0000521 int ms;
drh6d313162000-09-21 13:01:35 +0000522 if( objc!=3 ){
523 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
drhbec3f402000-08-04 13:49:02 +0000524 return TCL_ERROR;
525 }
drh6d313162000-09-21 13:01:35 +0000526 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
drhbec3f402000-08-04 13:49:02 +0000527 sqlite_busy_timeout(pDb->db, ms);
drh6d313162000-09-21 13:01:35 +0000528 break;
drh75897232000-05-29 14:26:00 +0000529 }
drh6d313162000-09-21 13:01:35 +0000530 } /* End of the SWITCH statement */
drh75897232000-05-29 14:26:00 +0000531 return TCL_OK;
532}
533
534/*
535** sqlite DBNAME FILENAME ?MODE?
536**
537** This is the main Tcl command. When the "sqlite" Tcl command is
538** invoked, this routine runs to process that command.
539**
540** The first argument, DBNAME, is an arbitrary name for a new
541** database connection. This command creates a new command named
542** DBNAME that is used to control that connection. The database
543** connection is deleted when the DBNAME command is deleted.
544**
545** The second argument is the name of the directory that contains
546** the sqlite database that is to be accessed.
drhfbc3eab2001-04-06 16:13:42 +0000547**
548** For testing purposes, we also support the following:
549**
550** sqlite -encoding
551**
552** Return the encoding used by LIKE and GLOB operators. Choices
553** are UTF-8 and iso8859.
554**
555** sqlite -tcl-uses-utf
556**
557** Return "1" if compiled with a Tcl uses UTF-8. Return "0" if
558** not. Used by tests to make sure the library was compiled
559** correctly.
drh75897232000-05-29 14:26:00 +0000560*/
561static int DbMain(void *cd, Tcl_Interp *interp, int argc, char **argv){
562 int mode;
drhbec3f402000-08-04 13:49:02 +0000563 SqliteDb *p;
drh75897232000-05-29 14:26:00 +0000564 char *zErrMsg;
drh06b27182002-06-26 20:06:05 +0000565 char zBuf[80];
drhfbc3eab2001-04-06 16:13:42 +0000566 if( argc==2 ){
567 if( strcmp(argv[1],"-encoding")==0 ){
568 Tcl_AppendResult(interp,sqlite_encoding,0);
569 return TCL_OK;
570 }
571 if( strcmp(argv[1],"-tcl-uses-utf")==0 ){
572#ifdef TCL_UTF_MAX
573 Tcl_AppendResult(interp,"1",0);
574#else
575 Tcl_AppendResult(interp,"0",0);
576#endif
577 return TCL_OK;
578 }
579 }
drh75897232000-05-29 14:26:00 +0000580 if( argc!=3 && argc!=4 ){
581 Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0],
582 " HANDLE FILENAME ?MODE?\"", 0);
583 return TCL_ERROR;
584 }
585 if( argc==3 ){
drh58b95762000-06-02 01:17:37 +0000586 mode = 0666;
drh75897232000-05-29 14:26:00 +0000587 }else if( Tcl_GetInt(interp, argv[3], &mode)!=TCL_OK ){
588 return TCL_ERROR;
589 }
590 zErrMsg = 0;
drh4cdc9e82000-08-04 14:56:24 +0000591 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
drh75897232000-05-29 14:26:00 +0000592 if( p==0 ){
drhbec3f402000-08-04 13:49:02 +0000593 Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
594 return TCL_ERROR;
595 }
596 memset(p, 0, sizeof(*p));
597 p->db = sqlite_open(argv[2], mode, &zErrMsg);
598 if( p->db==0 ){
drh75897232000-05-29 14:26:00 +0000599 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
drhbec3f402000-08-04 13:49:02 +0000600 Tcl_Free((char*)p);
drh75897232000-05-29 14:26:00 +0000601 free(zErrMsg);
602 return TCL_ERROR;
603 }
drh6d313162000-09-21 13:01:35 +0000604 Tcl_CreateObjCommand(interp, argv[1], DbObjCmd, (char*)p, DbDeleteCmd);
drhc22bd472002-05-10 13:14:07 +0000605
drh06b27182002-06-26 20:06:05 +0000606 /* The return value is the value of the sqlite* pointer
607 */
608 sprintf(zBuf, "%p", p->db);
drh5e5377f2002-07-07 17:12:36 +0000609 if( strncmp(zBuf,"0x",2) ){
610 sprintf(zBuf, "0x%p", p->db);
611 }
drh06b27182002-06-26 20:06:05 +0000612 Tcl_AppendResult(interp, zBuf, 0);
613
drhc22bd472002-05-10 13:14:07 +0000614 /* If compiled with SQLITE_TEST turned on, then register the "md5sum"
drh06b27182002-06-26 20:06:05 +0000615 ** SQL function.
drhc22bd472002-05-10 13:14:07 +0000616 */
drh28b4e482002-03-11 02:06:13 +0000617#ifdef SQLITE_TEST
618 {
drhc22bd472002-05-10 13:14:07 +0000619 extern void Md5_Register(sqlite*);
620 Md5_Register(p->db);
drh06b27182002-06-26 20:06:05 +0000621 }
drh28b4e482002-03-11 02:06:13 +0000622#endif
drh75897232000-05-29 14:26:00 +0000623 return TCL_OK;
624}
625
626/*
drh90ca9752001-09-28 17:47:14 +0000627** Provide a dummy Tcl_InitStubs if we are using this as a static
628** library.
629*/
630#ifndef USE_TCL_STUBS
631# undef Tcl_InitStubs
632# define Tcl_InitStubs(a,b,c)
633#endif
634
635/*
drh75897232000-05-29 14:26:00 +0000636** Initialize this module.
637**
638** This Tcl module contains only a single new Tcl command named "sqlite".
639** (Hence there is no namespace. There is no point in using a namespace
640** if the extension only supplies one new name!) The "sqlite" command is
641** used to open a new SQLite database. See the DbMain() routine above
642** for additional information.
643*/
644int Sqlite_Init(Tcl_Interp *interp){
drh90ca9752001-09-28 17:47:14 +0000645 Tcl_InitStubs(interp, "8.0", 0);
646 Tcl_CreateCommand(interp, "sqlite", DbMain, 0, 0);
drh6d4abfb2001-10-22 02:58:08 +0000647 Tcl_PkgProvide(interp, "sqlite", "2.0");
drh90ca9752001-09-28 17:47:14 +0000648 return TCL_OK;
649}
650int Tclsqlite_Init(Tcl_Interp *interp){
651 Tcl_InitStubs(interp, "8.0", 0);
drh75897232000-05-29 14:26:00 +0000652 Tcl_CreateCommand(interp, "sqlite", DbMain, 0, 0);
drh6d4abfb2001-10-22 02:58:08 +0000653 Tcl_PkgProvide(interp, "sqlite", "2.0");
drh75897232000-05-29 14:26:00 +0000654 return TCL_OK;
655}
656int Sqlite_SafeInit(Tcl_Interp *interp){
657 return TCL_OK;
658}
drh90ca9752001-09-28 17:47:14 +0000659int Tclsqlite_SafeInit(Tcl_Interp *interp){
660 return TCL_OK;
661}
drh75897232000-05-29 14:26:00 +0000662
drh3cebbde2000-10-19 14:59:27 +0000663#if 0
drh75897232000-05-29 14:26:00 +0000664/*
665** If compiled using mktclapp, this routine runs to initialize
666** everything.
667*/
668int Et_AppInit(Tcl_Interp *interp){
669 return Sqlite_Init(interp);
670}
drh3cebbde2000-10-19 14:59:27 +0000671#endif
drh348784e2000-05-29 20:41:49 +0000672
673/*
674** If the macro TCLSH is defined and is one, then put in code for the
675** "main" routine that will initialize Tcl.
676*/
677#if defined(TCLSH) && TCLSH==1
678static char zMainloop[] =
679 "set line {}\n"
680 "while {![eof stdin]} {\n"
681 "if {$line!=\"\"} {\n"
682 "puts -nonewline \"> \"\n"
683 "} else {\n"
684 "puts -nonewline \"% \"\n"
685 "}\n"
686 "flush stdout\n"
687 "append line [gets stdin]\n"
688 "if {[info complete $line]} {\n"
689 "if {[catch {uplevel #0 $line} result]} {\n"
690 "puts stderr \"Error: $result\"\n"
691 "} elseif {$result!=\"\"} {\n"
692 "puts $result\n"
693 "}\n"
694 "set line {}\n"
695 "} else {\n"
696 "append line \\n\n"
697 "}\n"
698 "}\n"
699;
700
701#define TCLSH_MAIN main /* Needed to fake out mktclapp */
702int TCLSH_MAIN(int argc, char **argv){
703 Tcl_Interp *interp;
drh297ecf12001-04-05 15:57:13 +0000704 Tcl_FindExecutable(argv[0]);
drh348784e2000-05-29 20:41:49 +0000705 interp = Tcl_CreateInterp();
706 Sqlite_Init(interp);
drhd9b02572001-04-15 00:37:09 +0000707#ifdef SQLITE_TEST
drhd1bf3512001-04-07 15:24:33 +0000708 {
709 extern int Sqlitetest1_Init(Tcl_Interp*);
drh5c4d9702001-08-20 00:33:58 +0000710 extern int Sqlitetest2_Init(Tcl_Interp*);
711 extern int Sqlitetest3_Init(Tcl_Interp*);
drhefc251d2001-07-01 22:12:01 +0000712 extern int Md5_Init(Tcl_Interp*);
drhd1bf3512001-04-07 15:24:33 +0000713 Sqlitetest1_Init(interp);
drh5c4d9702001-08-20 00:33:58 +0000714 Sqlitetest2_Init(interp);
715 Sqlitetest3_Init(interp);
drhefc251d2001-07-01 22:12:01 +0000716 Md5_Init(interp);
drhd1bf3512001-04-07 15:24:33 +0000717 }
718#endif
drh348784e2000-05-29 20:41:49 +0000719 if( argc>=2 ){
720 int i;
721 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
722 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
723 for(i=2; i<argc; i++){
724 Tcl_SetVar(interp, "argv", argv[i],
725 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
726 }
727 if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
drh0de8c112002-07-06 16:32:14 +0000728 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
drhc61053b2000-06-04 12:58:36 +0000729 if( zInfo==0 ) zInfo = interp->result;
730 fprintf(stderr,"%s: %s\n", *argv, zInfo);
drh348784e2000-05-29 20:41:49 +0000731 return 1;
732 }
733 }else{
734 Tcl_GlobalEval(interp, zMainloop);
735 }
736 return 0;
737}
738#endif /* TCLSH */
drh6d313162000-09-21 13:01:35 +0000739
740#endif /* !defined(NO_TCL) */