blob: 7df3f77419473729f6283124c0023702e111c88f [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**
drhc22bd472002-05-10 13:14:07 +000014** $Id: tclsqlite.c,v 1.32 2002/05/10 13:14:07 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
drh75897232000-05-29 14:26:00 +000018#include "sqlite.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);
98 }
drh6d4abfb2001-10-22 02:58:08 +000099 Tcl_DStringFree(&dCol);
100 }
drh6d4abfb2001-10-22 02:58:08 +0000101 }
102 if( azCol!=0 ){
103 if( cbData->zArray[0] ){
104 for(i=0; i<nCol; i++){
105 char *z = azCol[i];
106 if( z==0 ) z = "";
107 Tcl_DStringInit(&dCol);
108 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
109 Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i],
110 Tcl_DStringValue(&dCol), 0);
111 Tcl_DStringFree(&dCol);
112 }
113 }else{
114 for(i=0; i<nCol; i++){
115 char *z = azCol[i];
116 if( z==0 ) z = "";
117 Tcl_DStringInit(&dCol);
118 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
119 Tcl_SetVar(cbData->interp, cbData->azColName[i],
120 Tcl_DStringValue(&dCol), 0);
121 Tcl_DStringFree(&dCol);
122 }
123 }
124 }
125 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
126 if( rc==TCL_CONTINUE ) rc = TCL_OK;
127 cbData->tcl_rc = rc;
128 return rc!=TCL_OK;
129}
130#endif /* UTF_TRANSLATION_NEEDED */
131
132#ifndef UTF_TRANSLATION_NEEDED
133/*
134** Called for each row of the result.
135**
136** This version is used when either of the following is true:
137**
138** (1) This version of TCL uses UTF-8 and the data in the
139** SQLite database is already in the UTF-8 format.
140**
141** (2) This version of TCL uses ISO8859 and the data in the
142** SQLite database is already in the ISO8859 format.
143*/
144static int DbEvalCallback(
145 void *clientData, /* An instance of CallbackData */
146 int nCol, /* Number of columns in the result */
147 char ** azCol, /* Data for each column */
148 char ** azN /* Name for each column */
149){
150 CallbackData *cbData = (CallbackData*)clientData;
151 int i, rc;
drh6a535342001-10-19 16:44:56 +0000152 if( azCol==0 || (cbData->once && cbData->zArray[0]) ){
153 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
154 for(i=0; i<nCol; i++){
155 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", azN[i],
156 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
157 }
158 cbData->once = 0;
159 }
160 if( azCol!=0 ){
161 if( cbData->zArray[0] ){
drh75897232000-05-29 14:26:00 +0000162 for(i=0; i<nCol; i++){
drh6a535342001-10-19 16:44:56 +0000163 char *z = azCol[i];
164 if( z==0 ) z = "";
drh6a535342001-10-19 16:44:56 +0000165 Tcl_SetVar2(cbData->interp, cbData->zArray, azN[i], z, 0);
drh6a535342001-10-19 16:44:56 +0000166 }
167 }else{
168 for(i=0; i<nCol; i++){
169 char *z = azCol[i];
170 if( z==0 ) z = "";
drh6a535342001-10-19 16:44:56 +0000171 Tcl_SetVar(cbData->interp, azN[i], z, 0);
drh75897232000-05-29 14:26:00 +0000172 }
173 }
drh75897232000-05-29 14:26:00 +0000174 }
drh6d313162000-09-21 13:01:35 +0000175 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
drh960e8c62001-04-03 16:53:21 +0000176 if( rc==TCL_CONTINUE ) rc = TCL_OK;
177 cbData->tcl_rc = rc;
178 return rc!=TCL_OK;
drh75897232000-05-29 14:26:00 +0000179}
drh6d4abfb2001-10-22 02:58:08 +0000180#endif
drh75897232000-05-29 14:26:00 +0000181
182/*
drh6d313162000-09-21 13:01:35 +0000183** This is an alternative callback for database queries. Instead
184** of invoking a TCL script to handle the result, this callback just
185** appends each column of the result to a list. After the query
186** is complete, the list is returned.
187*/
188static int DbEvalCallback2(
189 void *clientData, /* An instance of CallbackData */
190 int nCol, /* Number of columns in the result */
191 char ** azCol, /* Data for each column */
192 char ** azN /* Name for each column */
193){
194 Tcl_Obj *pList = (Tcl_Obj*)clientData;
195 int i;
drh6a535342001-10-19 16:44:56 +0000196 if( azCol==0 ) return 0;
drh6d313162000-09-21 13:01:35 +0000197 for(i=0; i<nCol; i++){
198 Tcl_Obj *pElem;
199 if( azCol[i] && *azCol[i] ){
drh297ecf12001-04-05 15:57:13 +0000200#ifdef UTF_TRANSLATION_NEEDED
201 Tcl_DString dCol;
202 Tcl_DStringInit(&dCol);
203 Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol);
204 pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
205 Tcl_DStringFree(&dCol);
206#else
drh6d313162000-09-21 13:01:35 +0000207 pElem = Tcl_NewStringObj(azCol[i], -1);
drh297ecf12001-04-05 15:57:13 +0000208#endif
drh6d313162000-09-21 13:01:35 +0000209 }else{
210 pElem = Tcl_NewObj();
211 }
212 Tcl_ListObjAppendElement(0, pList, pElem);
213 }
214 return 0;
215}
216
217/*
drh75897232000-05-29 14:26:00 +0000218** Called when the command is deleted.
219*/
220static void DbDeleteCmd(void *db){
drhbec3f402000-08-04 13:49:02 +0000221 SqliteDb *pDb = (SqliteDb*)db;
222 sqlite_close(pDb->db);
223 if( pDb->zBusy ){
224 Tcl_Free(pDb->zBusy);
225 }
226 Tcl_Free((char*)pDb);
227}
228
229/*
230** This routine is called when a database file is locked while trying
231** to execute SQL.
232*/
233static int DbBusyHandler(void *cd, const char *zTable, int nTries){
234 SqliteDb *pDb = (SqliteDb*)cd;
235 int rc;
236 char zVal[30];
237 char *zCmd;
drhbec3f402000-08-04 13:49:02 +0000238 Tcl_DString cmd;
239
240 Tcl_DStringInit(&cmd);
241 Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
242 Tcl_DStringAppendElement(&cmd, zTable);
243 sprintf(zVal, " %d", nTries);
244 Tcl_DStringAppend(&cmd, zVal, -1);
245 zCmd = Tcl_DStringValue(&cmd);
246 rc = Tcl_Eval(pDb->interp, zCmd);
247 Tcl_DStringFree(&cmd);
248 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
249 return 0;
250 }
251 return 1;
drh75897232000-05-29 14:26:00 +0000252}
253
254/*
255** The "sqlite" command below creates a new Tcl command for each
256** connection it opens to an SQLite database. This routine is invoked
257** whenever one of those connection-specific commands is executed
258** in Tcl. For example, if you run Tcl code like this:
259**
260** sqlite db1 "my_database"
261** db1 close
262**
263** The first command opens a connection to the "my_database" database
264** and calls that connection "db1". The second command causes this
265** subroutine to be invoked.
266*/
drh6d313162000-09-21 13:01:35 +0000267static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
drhbec3f402000-08-04 13:49:02 +0000268 SqliteDb *pDb = (SqliteDb*)cd;
drh6d313162000-09-21 13:01:35 +0000269 int choice;
270 static char *DB_optStrs[] = {
drhc8d30ac2002-04-12 10:08:59 +0000271 "busy", "changes", "close", "complete",
272 "eval", "last_insert_rowid", "timeout", 0
drh6d313162000-09-21 13:01:35 +0000273 };
274 enum DB_opts {
drhc8d30ac2002-04-12 10:08:59 +0000275 DB_BUSY, DB_CHANGES, DB_CLOSE, DB_COMPLETE,
276 DB_EVAL, DB_LAST_INSERT_ROWID, DB_TIMEOUT
drh6d313162000-09-21 13:01:35 +0000277 };
278
279 if( objc<2 ){
280 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
drh75897232000-05-29 14:26:00 +0000281 return TCL_ERROR;
282 }
drh6d313162000-09-21 13:01:35 +0000283 if( Tcl_GetIndexFromObj(interp, objv[1], DB_optStrs, "option", 0, &choice) ){
284 return TCL_ERROR;
285 }
286
287 switch( (enum DB_opts)choice ){
drh75897232000-05-29 14:26:00 +0000288
drhbec3f402000-08-04 13:49:02 +0000289 /* $db busy ?CALLBACK?
290 **
291 ** Invoke the given callback if an SQL statement attempts to open
292 ** a locked database file.
293 */
drh6d313162000-09-21 13:01:35 +0000294 case DB_BUSY: {
295 if( objc>3 ){
296 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
drhbec3f402000-08-04 13:49:02 +0000297 return TCL_ERROR;
drh6d313162000-09-21 13:01:35 +0000298 }else if( objc==2 ){
drhbec3f402000-08-04 13:49:02 +0000299 if( pDb->zBusy ){
300 Tcl_AppendResult(interp, pDb->zBusy, 0);
301 }
302 }else{
drh6d313162000-09-21 13:01:35 +0000303 char *zBusy;
304 int len;
drhbec3f402000-08-04 13:49:02 +0000305 if( pDb->zBusy ){
306 Tcl_Free(pDb->zBusy);
drhbec3f402000-08-04 13:49:02 +0000307 }
drh6d313162000-09-21 13:01:35 +0000308 zBusy = Tcl_GetStringFromObj(objv[2], &len);
309 if( zBusy && len>0 ){
310 pDb->zBusy = Tcl_Alloc( len + 1 );
311 strcpy(pDb->zBusy, zBusy);
312 }else{
313 pDb->zBusy = 0;
drhbec3f402000-08-04 13:49:02 +0000314 }
315 if( pDb->zBusy ){
316 pDb->interp = interp;
317 sqlite_busy_handler(pDb->db, DbBusyHandler, pDb);
drh6d313162000-09-21 13:01:35 +0000318 }else{
319 sqlite_busy_handler(pDb->db, 0, 0);
drhbec3f402000-08-04 13:49:02 +0000320 }
321 }
drh6d313162000-09-21 13:01:35 +0000322 break;
323 }
drhbec3f402000-08-04 13:49:02 +0000324
drhc8d30ac2002-04-12 10:08:59 +0000325 /*
326 ** $db changes
327 **
328 ** Return the number of rows that were modified, inserted, or deleted by
329 ** the most recent "eval".
330 */
331 case DB_CHANGES: {
332 Tcl_Obj *pResult;
333 int nChange;
334 if( objc!=2 ){
335 Tcl_WrongNumArgs(interp, 2, objv, "");
336 return TCL_ERROR;
337 }
338 nChange = sqlite_changes(pDb->db);
339 pResult = Tcl_GetObjResult(interp);
340 Tcl_SetIntObj(pResult, nChange);
341 break;
342 }
343
drh75897232000-05-29 14:26:00 +0000344 /* $db close
345 **
346 ** Shutdown the database
347 */
drh6d313162000-09-21 13:01:35 +0000348 case DB_CLOSE: {
349 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
350 break;
351 }
drh75897232000-05-29 14:26:00 +0000352
353 /* $db complete SQL
354 **
355 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
356 ** additional lines of input are needed. This is similar to the
357 ** built-in "info complete" command of Tcl.
358 */
drh6d313162000-09-21 13:01:35 +0000359 case DB_COMPLETE: {
360 Tcl_Obj *pResult;
361 int isComplete;
362 if( objc!=3 ){
363 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
drh75897232000-05-29 14:26:00 +0000364 return TCL_ERROR;
365 }
drh6d313162000-09-21 13:01:35 +0000366 isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) );
367 pResult = Tcl_GetObjResult(interp);
368 Tcl_SetBooleanObj(pResult, isComplete);
369 break;
370 }
drh75897232000-05-29 14:26:00 +0000371
372 /*
373 ** $db eval $sql ?array { ...code... }?
374 **
375 ** The SQL statement in $sql is evaluated. For each row, the values are
drhbec3f402000-08-04 13:49:02 +0000376 ** placed in elements of the array named "array" and ...code... is executed.
drh75897232000-05-29 14:26:00 +0000377 ** If "array" and "code" are omitted, then no callback is every invoked.
378 ** If "array" is an empty string, then the values are placed in variables
379 ** that have the same name as the fields extracted by the query.
380 */
drh6d313162000-09-21 13:01:35 +0000381 case DB_EVAL: {
drh75897232000-05-29 14:26:00 +0000382 CallbackData cbData;
383 char *zErrMsg;
drh6d313162000-09-21 13:01:35 +0000384 char *zSql;
drh75897232000-05-29 14:26:00 +0000385 int rc;
drh297ecf12001-04-05 15:57:13 +0000386#ifdef UTF_TRANSLATION_NEEDED
387 Tcl_DString dSql;
drh6d4abfb2001-10-22 02:58:08 +0000388 int i;
drh297ecf12001-04-05 15:57:13 +0000389#endif
drh75897232000-05-29 14:26:00 +0000390
drh6d313162000-09-21 13:01:35 +0000391 if( objc!=5 && objc!=3 ){
392 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?");
drh75897232000-05-29 14:26:00 +0000393 return TCL_ERROR;
394 }
drhbec3f402000-08-04 13:49:02 +0000395 pDb->interp = interp;
drh6d313162000-09-21 13:01:35 +0000396 zSql = Tcl_GetStringFromObj(objv[2], 0);
drh297ecf12001-04-05 15:57:13 +0000397#ifdef UTF_TRANSLATION_NEEDED
398 Tcl_DStringInit(&dSql);
399 Tcl_UtfToExternalDString(NULL, zSql, -1, &dSql);
400 zSql = Tcl_DStringValue(&dSql);
401#endif
drh6d313162000-09-21 13:01:35 +0000402 Tcl_IncrRefCount(objv[2]);
403 if( objc==5 ){
drh75897232000-05-29 14:26:00 +0000404 cbData.interp = interp;
drhdcc581c2000-05-30 13:44:19 +0000405 cbData.once = 1;
drh6d313162000-09-21 13:01:35 +0000406 cbData.zArray = Tcl_GetStringFromObj(objv[3], 0);
407 cbData.pCode = objv[4];
drh960e8c62001-04-03 16:53:21 +0000408 cbData.tcl_rc = TCL_OK;
drh6d4abfb2001-10-22 02:58:08 +0000409 cbData.nColName = 0;
410 cbData.azColName = 0;
drh75897232000-05-29 14:26:00 +0000411 zErrMsg = 0;
drh6d313162000-09-21 13:01:35 +0000412 Tcl_IncrRefCount(objv[3]);
413 Tcl_IncrRefCount(objv[4]);
414 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg);
415 Tcl_DecrRefCount(objv[4]);
416 Tcl_DecrRefCount(objv[3]);
drh960e8c62001-04-03 16:53:21 +0000417 if( cbData.tcl_rc==TCL_BREAK ){ cbData.tcl_rc = TCL_OK; }
drh75897232000-05-29 14:26:00 +0000418 }else{
drh6d313162000-09-21 13:01:35 +0000419 Tcl_Obj *pList = Tcl_NewObj();
drh960e8c62001-04-03 16:53:21 +0000420 cbData.tcl_rc = TCL_OK;
drh6d313162000-09-21 13:01:35 +0000421 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg);
422 Tcl_SetObjResult(interp, pList);
drh75897232000-05-29 14:26:00 +0000423 }
424 if( zErrMsg ){
425 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
426 free(zErrMsg);
drh960e8c62001-04-03 16:53:21 +0000427 rc = TCL_ERROR;
drh6d4abfb2001-10-22 02:58:08 +0000428 }else if( rc!=SQLITE_OK && rc!=SQLITE_ABORT ){
429 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
430 rc = TCL_ERROR;
drh960e8c62001-04-03 16:53:21 +0000431 }else{
432 rc = cbData.tcl_rc;
drh75897232000-05-29 14:26:00 +0000433 }
drh6d313162000-09-21 13:01:35 +0000434 Tcl_DecrRefCount(objv[2]);
drh297ecf12001-04-05 15:57:13 +0000435#ifdef UTF_TRANSLATION_NEEDED
436 Tcl_DStringFree(&dSql);
drh6d4abfb2001-10-22 02:58:08 +0000437 if( objc==5 && cbData.azColName ){
438 for(i=0; i<cbData.nColName; i++){
439 if( cbData.azColName[i] ) free(cbData.azColName[i]);
440 }
441 free(cbData.azColName);
drhce927062001-11-09 13:41:09 +0000442 cbData.azColName = 0;
drh6d4abfb2001-10-22 02:58:08 +0000443 }
drh297ecf12001-04-05 15:57:13 +0000444#endif
drh75897232000-05-29 14:26:00 +0000445 return rc;
drh6d313162000-09-21 13:01:35 +0000446 }
drhbec3f402000-08-04 13:49:02 +0000447
448 /*
drhaf9ff332002-01-16 21:00:27 +0000449 ** $db last_insert_rowid
450 **
451 ** Return an integer which is the ROWID for the most recent insert.
452 */
453 case DB_LAST_INSERT_ROWID: {
454 Tcl_Obj *pResult;
455 int rowid;
456 if( objc!=2 ){
457 Tcl_WrongNumArgs(interp, 2, objv, "");
458 return TCL_ERROR;
459 }
460 rowid = sqlite_last_insert_rowid(pDb->db);
461 pResult = Tcl_GetObjResult(interp);
462 Tcl_SetIntObj(pResult, rowid);
463 break;
464 }
465
466 /*
drhbec3f402000-08-04 13:49:02 +0000467 ** $db timeout MILLESECONDS
468 **
469 ** Delay for the number of milliseconds specified when a file is locked.
470 */
drh6d313162000-09-21 13:01:35 +0000471 case DB_TIMEOUT: {
drhbec3f402000-08-04 13:49:02 +0000472 int ms;
drh6d313162000-09-21 13:01:35 +0000473 if( objc!=3 ){
474 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
drhbec3f402000-08-04 13:49:02 +0000475 return TCL_ERROR;
476 }
drh6d313162000-09-21 13:01:35 +0000477 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
drhbec3f402000-08-04 13:49:02 +0000478 sqlite_busy_timeout(pDb->db, ms);
drh6d313162000-09-21 13:01:35 +0000479 break;
drh75897232000-05-29 14:26:00 +0000480 }
drh6d313162000-09-21 13:01:35 +0000481 } /* End of the SWITCH statement */
drh75897232000-05-29 14:26:00 +0000482 return TCL_OK;
483}
484
485/*
486** sqlite DBNAME FILENAME ?MODE?
487**
488** This is the main Tcl command. When the "sqlite" Tcl command is
489** invoked, this routine runs to process that command.
490**
491** The first argument, DBNAME, is an arbitrary name for a new
492** database connection. This command creates a new command named
493** DBNAME that is used to control that connection. The database
494** connection is deleted when the DBNAME command is deleted.
495**
496** The second argument is the name of the directory that contains
497** the sqlite database that is to be accessed.
drhfbc3eab2001-04-06 16:13:42 +0000498**
499** For testing purposes, we also support the following:
500**
501** sqlite -encoding
502**
503** Return the encoding used by LIKE and GLOB operators. Choices
504** are UTF-8 and iso8859.
505**
506** sqlite -tcl-uses-utf
507**
508** Return "1" if compiled with a Tcl uses UTF-8. Return "0" if
509** not. Used by tests to make sure the library was compiled
510** correctly.
drh75897232000-05-29 14:26:00 +0000511*/
512static int DbMain(void *cd, Tcl_Interp *interp, int argc, char **argv){
513 int mode;
drhbec3f402000-08-04 13:49:02 +0000514 SqliteDb *p;
drh75897232000-05-29 14:26:00 +0000515 char *zErrMsg;
drhfbc3eab2001-04-06 16:13:42 +0000516 if( argc==2 ){
517 if( strcmp(argv[1],"-encoding")==0 ){
518 Tcl_AppendResult(interp,sqlite_encoding,0);
519 return TCL_OK;
520 }
521 if( strcmp(argv[1],"-tcl-uses-utf")==0 ){
522#ifdef TCL_UTF_MAX
523 Tcl_AppendResult(interp,"1",0);
524#else
525 Tcl_AppendResult(interp,"0",0);
526#endif
527 return TCL_OK;
528 }
529 }
drh75897232000-05-29 14:26:00 +0000530 if( argc!=3 && argc!=4 ){
531 Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0],
532 " HANDLE FILENAME ?MODE?\"", 0);
533 return TCL_ERROR;
534 }
535 if( argc==3 ){
drh58b95762000-06-02 01:17:37 +0000536 mode = 0666;
drh75897232000-05-29 14:26:00 +0000537 }else if( Tcl_GetInt(interp, argv[3], &mode)!=TCL_OK ){
538 return TCL_ERROR;
539 }
540 zErrMsg = 0;
drh4cdc9e82000-08-04 14:56:24 +0000541 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
drh75897232000-05-29 14:26:00 +0000542 if( p==0 ){
drhbec3f402000-08-04 13:49:02 +0000543 Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
544 return TCL_ERROR;
545 }
546 memset(p, 0, sizeof(*p));
547 p->db = sqlite_open(argv[2], mode, &zErrMsg);
548 if( p->db==0 ){
drh75897232000-05-29 14:26:00 +0000549 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
drhbec3f402000-08-04 13:49:02 +0000550 Tcl_Free((char*)p);
drh75897232000-05-29 14:26:00 +0000551 free(zErrMsg);
552 return TCL_ERROR;
553 }
drh6d313162000-09-21 13:01:35 +0000554 Tcl_CreateObjCommand(interp, argv[1], DbObjCmd, (char*)p, DbDeleteCmd);
drhc22bd472002-05-10 13:14:07 +0000555
556 /* If compiled with SQLITE_TEST turned on, then register the "md5sum"
557 ** SQL function and return an integer which is the memory address of
558 ** the underlying sqlite* pointer.
559 */
drh28b4e482002-03-11 02:06:13 +0000560#ifdef SQLITE_TEST
561 {
drhc22bd472002-05-10 13:14:07 +0000562 char zBuf[40];
563 extern void Md5_Register(sqlite*);
564 Md5_Register(p->db);
565 sprintf(zBuf, "%d", (int)p->db);
566 Tcl_AppendResult(interp, zBuf, 0);
drh28b4e482002-03-11 02:06:13 +0000567 }
568#endif
drh75897232000-05-29 14:26:00 +0000569 return TCL_OK;
570}
571
572/*
drh90ca9752001-09-28 17:47:14 +0000573** Provide a dummy Tcl_InitStubs if we are using this as a static
574** library.
575*/
576#ifndef USE_TCL_STUBS
577# undef Tcl_InitStubs
578# define Tcl_InitStubs(a,b,c)
579#endif
580
581/*
drh75897232000-05-29 14:26:00 +0000582** Initialize this module.
583**
584** This Tcl module contains only a single new Tcl command named "sqlite".
585** (Hence there is no namespace. There is no point in using a namespace
586** if the extension only supplies one new name!) The "sqlite" command is
587** used to open a new SQLite database. See the DbMain() routine above
588** for additional information.
589*/
590int Sqlite_Init(Tcl_Interp *interp){
drh90ca9752001-09-28 17:47:14 +0000591 Tcl_InitStubs(interp, "8.0", 0);
592 Tcl_CreateCommand(interp, "sqlite", DbMain, 0, 0);
drh6d4abfb2001-10-22 02:58:08 +0000593 Tcl_PkgProvide(interp, "sqlite", "2.0");
drh90ca9752001-09-28 17:47:14 +0000594 return TCL_OK;
595}
596int Tclsqlite_Init(Tcl_Interp *interp){
597 Tcl_InitStubs(interp, "8.0", 0);
drh75897232000-05-29 14:26:00 +0000598 Tcl_CreateCommand(interp, "sqlite", DbMain, 0, 0);
drh6d4abfb2001-10-22 02:58:08 +0000599 Tcl_PkgProvide(interp, "sqlite", "2.0");
drh75897232000-05-29 14:26:00 +0000600 return TCL_OK;
601}
602int Sqlite_SafeInit(Tcl_Interp *interp){
603 return TCL_OK;
604}
drh90ca9752001-09-28 17:47:14 +0000605int Tclsqlite_SafeInit(Tcl_Interp *interp){
606 return TCL_OK;
607}
drh75897232000-05-29 14:26:00 +0000608
drh3cebbde2000-10-19 14:59:27 +0000609#if 0
drh75897232000-05-29 14:26:00 +0000610/*
611** If compiled using mktclapp, this routine runs to initialize
612** everything.
613*/
614int Et_AppInit(Tcl_Interp *interp){
615 return Sqlite_Init(interp);
616}
drh3cebbde2000-10-19 14:59:27 +0000617#endif
drh348784e2000-05-29 20:41:49 +0000618
619/*
620** If the macro TCLSH is defined and is one, then put in code for the
621** "main" routine that will initialize Tcl.
622*/
623#if defined(TCLSH) && TCLSH==1
624static char zMainloop[] =
625 "set line {}\n"
626 "while {![eof stdin]} {\n"
627 "if {$line!=\"\"} {\n"
628 "puts -nonewline \"> \"\n"
629 "} else {\n"
630 "puts -nonewline \"% \"\n"
631 "}\n"
632 "flush stdout\n"
633 "append line [gets stdin]\n"
634 "if {[info complete $line]} {\n"
635 "if {[catch {uplevel #0 $line} result]} {\n"
636 "puts stderr \"Error: $result\"\n"
637 "} elseif {$result!=\"\"} {\n"
638 "puts $result\n"
639 "}\n"
640 "set line {}\n"
641 "} else {\n"
642 "append line \\n\n"
643 "}\n"
644 "}\n"
645;
646
647#define TCLSH_MAIN main /* Needed to fake out mktclapp */
648int TCLSH_MAIN(int argc, char **argv){
649 Tcl_Interp *interp;
drh297ecf12001-04-05 15:57:13 +0000650 Tcl_FindExecutable(argv[0]);
drh348784e2000-05-29 20:41:49 +0000651 interp = Tcl_CreateInterp();
652 Sqlite_Init(interp);
drhd9b02572001-04-15 00:37:09 +0000653#ifdef SQLITE_TEST
drhd1bf3512001-04-07 15:24:33 +0000654 {
655 extern int Sqlitetest1_Init(Tcl_Interp*);
drh5c4d9702001-08-20 00:33:58 +0000656 extern int Sqlitetest2_Init(Tcl_Interp*);
657 extern int Sqlitetest3_Init(Tcl_Interp*);
drhefc251d2001-07-01 22:12:01 +0000658 extern int Md5_Init(Tcl_Interp*);
drhd1bf3512001-04-07 15:24:33 +0000659 Sqlitetest1_Init(interp);
drh5c4d9702001-08-20 00:33:58 +0000660 Sqlitetest2_Init(interp);
661 Sqlitetest3_Init(interp);
drhefc251d2001-07-01 22:12:01 +0000662 Md5_Init(interp);
drhd1bf3512001-04-07 15:24:33 +0000663 }
664#endif
drh348784e2000-05-29 20:41:49 +0000665 if( argc>=2 ){
666 int i;
667 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
668 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
669 for(i=2; i<argc; i++){
670 Tcl_SetVar(interp, "argv", argv[i],
671 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
672 }
673 if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
drhc61053b2000-06-04 12:58:36 +0000674 char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
675 if( zInfo==0 ) zInfo = interp->result;
676 fprintf(stderr,"%s: %s\n", *argv, zInfo);
drh348784e2000-05-29 20:41:49 +0000677 return 1;
678 }
679 }else{
680 Tcl_GlobalEval(interp, zMainloop);
681 }
682 return 0;
683}
684#endif /* TCLSH */
drh6d313162000-09-21 13:01:35 +0000685
686#endif /* !defined(NO_TCL) */