blob: 20d7499f0dc5054810fed51abf2db68e933b756e [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**
drh81e293b2003-06-06 19:00:42 +000014** $Id: tclsqlite.c,v 1.49 2003/06/06 19:00:42 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/*
drhcabb0812002-09-14 13:47:32 +000035** New SQL functions can be created as TCL scripts. Each such function
36** is described by an instance of the following structure.
37*/
38typedef struct SqlFunc SqlFunc;
39struct SqlFunc {
40 Tcl_Interp *interp; /* The TCL interpret to execute the function */
41 char *zScript; /* The script to be run */
42 SqlFunc *pNext; /* Next function on the list of them all */
43};
44
45/*
drhbec3f402000-08-04 13:49:02 +000046** There is one instance of this structure for each SQLite database
47** that has been opened by the SQLite TCL interface.
48*/
49typedef struct SqliteDb SqliteDb;
50struct SqliteDb {
51 sqlite *db; /* The "real" database structure */
52 Tcl_Interp *interp; /* The interpreter used for this database */
drh6d313162000-09-21 13:01:35 +000053 char *zBusy; /* The busy callback routine */
drhb5a20d32003-04-23 12:25:23 +000054 char *zTrace; /* The trace callback routine */
drhe22a3342003-04-22 20:30:37 +000055 char *zAuth; /* The authorization callback routine */
drhcabb0812002-09-14 13:47:32 +000056 SqlFunc *pFunc; /* List of SQL functions */
drhdcd997e2003-01-31 17:21:49 +000057 int rc; /* Return code of most recent sqlite_exec() */
drhbec3f402000-08-04 13:49:02 +000058};
59
60/*
drh75897232000-05-29 14:26:00 +000061** An instance of this structure passes information thru the sqlite
62** logic from the original TCL command into the callback routine.
63*/
64typedef struct CallbackData CallbackData;
65struct CallbackData {
66 Tcl_Interp *interp; /* The TCL interpreter */
67 char *zArray; /* The array into which data is written */
drh6d313162000-09-21 13:01:35 +000068 Tcl_Obj *pCode; /* The code to execute for each row */
drhce927062001-11-09 13:41:09 +000069 int once; /* Set for first callback only */
drh960e8c62001-04-03 16:53:21 +000070 int tcl_rc; /* Return code from TCL script */
drh98808ba2001-10-18 12:34:46 +000071 int nColName; /* Number of entries in the azColName[] array */
72 char **azColName; /* Column names translated to UTF-8 */
drh98808ba2001-10-18 12:34:46 +000073};
drh297ecf12001-04-05 15:57:13 +000074
drh6d4abfb2001-10-22 02:58:08 +000075#ifdef UTF_TRANSLATION_NEEDED
drh297ecf12001-04-05 15:57:13 +000076/*
drh75897232000-05-29 14:26:00 +000077** Called for each row of the result.
drh6d4abfb2001-10-22 02:58:08 +000078**
79** This version is used when TCL expects UTF-8 data but the database
80** uses the ISO8859 format. A translation must occur from ISO8859 into
81** UTF-8.
drh75897232000-05-29 14:26:00 +000082*/
83static int DbEvalCallback(
84 void *clientData, /* An instance of CallbackData */
85 int nCol, /* Number of columns in the result */
86 char ** azCol, /* Data for each column */
87 char ** azN /* Name for each column */
88){
89 CallbackData *cbData = (CallbackData*)clientData;
90 int i, rc;
drh297ecf12001-04-05 15:57:13 +000091 Tcl_DString dCol;
drh6d4abfb2001-10-22 02:58:08 +000092 Tcl_DStringInit(&dCol);
drhce927062001-11-09 13:41:09 +000093 if( cbData->azColName==0 ){
94 assert( cbData->once );
95 cbData->once = 0;
96 if( cbData->zArray[0] ){
97 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
drh6d4abfb2001-10-22 02:58:08 +000098 }
drhce927062001-11-09 13:41:09 +000099 cbData->azColName = malloc( nCol*sizeof(char*) );
100 if( cbData->azColName==0 ){ return 1; }
drh6d4abfb2001-10-22 02:58:08 +0000101 cbData->nColName = nCol;
102 for(i=0; i<nCol; i++){
103 Tcl_ExternalToUtfDString(NULL, azN[i], -1, &dCol);
drhce927062001-11-09 13:41:09 +0000104 cbData->azColName[i] = malloc( Tcl_DStringLength(&dCol) + 1 );
105 if( cbData->azColName[i] ){
106 strcpy(cbData->azColName[i], Tcl_DStringValue(&dCol));
107 }else{
108 return 1;
drh6d4abfb2001-10-22 02:58:08 +0000109 }
drhce927062001-11-09 13:41:09 +0000110 if( cbData->zArray[0] ){
111 Tcl_SetVar2(cbData->interp, cbData->zArray, "*",
112 Tcl_DStringValue(&dCol), TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
drh704027f2002-07-15 20:58:47 +0000113 if( azN[nCol]!=0 ){
drh5080aaa2002-07-11 12:18:16 +0000114 Tcl_DString dType;
115 Tcl_DStringInit(&dType);
116 Tcl_DStringAppend(&dType, "typeof:", -1);
117 Tcl_DStringAppend(&dType, Tcl_DStringValue(&dCol), -1);
118 Tcl_DStringFree(&dCol);
119 Tcl_ExternalToUtfDString(NULL, azN[i+nCol], -1, &dCol);
120 Tcl_SetVar2(cbData->interp, cbData->zArray,
121 Tcl_DStringValue(&dType), Tcl_DStringValue(&dCol),
122 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
123 Tcl_DStringFree(&dType);
124 }
drhce927062001-11-09 13:41:09 +0000125 }
drhfa173a72002-07-10 21:26:00 +0000126
drh6d4abfb2001-10-22 02:58:08 +0000127 Tcl_DStringFree(&dCol);
128 }
drh6d4abfb2001-10-22 02:58:08 +0000129 }
130 if( azCol!=0 ){
131 if( cbData->zArray[0] ){
132 for(i=0; i<nCol; i++){
133 char *z = azCol[i];
134 if( z==0 ) z = "";
135 Tcl_DStringInit(&dCol);
136 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
137 Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i],
138 Tcl_DStringValue(&dCol), 0);
139 Tcl_DStringFree(&dCol);
140 }
141 }else{
142 for(i=0; i<nCol; i++){
143 char *z = azCol[i];
144 if( z==0 ) z = "";
145 Tcl_DStringInit(&dCol);
146 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
147 Tcl_SetVar(cbData->interp, cbData->azColName[i],
148 Tcl_DStringValue(&dCol), 0);
149 Tcl_DStringFree(&dCol);
150 }
151 }
152 }
153 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
154 if( rc==TCL_CONTINUE ) rc = TCL_OK;
155 cbData->tcl_rc = rc;
156 return rc!=TCL_OK;
157}
158#endif /* UTF_TRANSLATION_NEEDED */
159
160#ifndef UTF_TRANSLATION_NEEDED
161/*
162** Called for each row of the result.
163**
164** This version is used when either of the following is true:
165**
166** (1) This version of TCL uses UTF-8 and the data in the
167** SQLite database is already in the UTF-8 format.
168**
169** (2) This version of TCL uses ISO8859 and the data in the
170** SQLite database is already in the ISO8859 format.
171*/
172static int DbEvalCallback(
173 void *clientData, /* An instance of CallbackData */
174 int nCol, /* Number of columns in the result */
175 char ** azCol, /* Data for each column */
176 char ** azN /* Name for each column */
177){
178 CallbackData *cbData = (CallbackData*)clientData;
179 int i, rc;
drh6a535342001-10-19 16:44:56 +0000180 if( azCol==0 || (cbData->once && cbData->zArray[0]) ){
181 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
182 for(i=0; i<nCol; i++){
183 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", azN[i],
184 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
drh5080aaa2002-07-11 12:18:16 +0000185 if( azN[nCol] ){
186 char *z = sqlite_mprintf("typeof:%s", azN[i]);
187 Tcl_SetVar2(cbData->interp, cbData->zArray, z, azN[i+nCol],
188 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
189 sqlite_freemem(z);
190 }
drh6a535342001-10-19 16:44:56 +0000191 }
192 cbData->once = 0;
193 }
194 if( azCol!=0 ){
195 if( cbData->zArray[0] ){
drh75897232000-05-29 14:26:00 +0000196 for(i=0; i<nCol; i++){
drh6a535342001-10-19 16:44:56 +0000197 char *z = azCol[i];
198 if( z==0 ) z = "";
drh6a535342001-10-19 16:44:56 +0000199 Tcl_SetVar2(cbData->interp, cbData->zArray, azN[i], z, 0);
drh6a535342001-10-19 16:44:56 +0000200 }
201 }else{
202 for(i=0; i<nCol; i++){
203 char *z = azCol[i];
204 if( z==0 ) z = "";
drh6a535342001-10-19 16:44:56 +0000205 Tcl_SetVar(cbData->interp, azN[i], z, 0);
drh75897232000-05-29 14:26:00 +0000206 }
207 }
drh75897232000-05-29 14:26:00 +0000208 }
drh6d313162000-09-21 13:01:35 +0000209 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
drh960e8c62001-04-03 16:53:21 +0000210 if( rc==TCL_CONTINUE ) rc = TCL_OK;
211 cbData->tcl_rc = rc;
212 return rc!=TCL_OK;
drh75897232000-05-29 14:26:00 +0000213}
drh6d4abfb2001-10-22 02:58:08 +0000214#endif
drh75897232000-05-29 14:26:00 +0000215
216/*
drh6d313162000-09-21 13:01:35 +0000217** This is an alternative callback for database queries. Instead
218** of invoking a TCL script to handle the result, this callback just
219** appends each column of the result to a list. After the query
220** is complete, the list is returned.
221*/
222static int DbEvalCallback2(
223 void *clientData, /* An instance of CallbackData */
224 int nCol, /* Number of columns in the result */
225 char ** azCol, /* Data for each column */
226 char ** azN /* Name for each column */
227){
228 Tcl_Obj *pList = (Tcl_Obj*)clientData;
229 int i;
drh6a535342001-10-19 16:44:56 +0000230 if( azCol==0 ) return 0;
drh6d313162000-09-21 13:01:35 +0000231 for(i=0; i<nCol; i++){
232 Tcl_Obj *pElem;
233 if( azCol[i] && *azCol[i] ){
drh297ecf12001-04-05 15:57:13 +0000234#ifdef UTF_TRANSLATION_NEEDED
235 Tcl_DString dCol;
236 Tcl_DStringInit(&dCol);
237 Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol);
238 pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
239 Tcl_DStringFree(&dCol);
240#else
drh6d313162000-09-21 13:01:35 +0000241 pElem = Tcl_NewStringObj(azCol[i], -1);
drh297ecf12001-04-05 15:57:13 +0000242#endif
drh6d313162000-09-21 13:01:35 +0000243 }else{
244 pElem = Tcl_NewObj();
245 }
246 Tcl_ListObjAppendElement(0, pList, pElem);
247 }
248 return 0;
249}
250
251/*
drh75897232000-05-29 14:26:00 +0000252** Called when the command is deleted.
253*/
254static void DbDeleteCmd(void *db){
drhbec3f402000-08-04 13:49:02 +0000255 SqliteDb *pDb = (SqliteDb*)db;
256 sqlite_close(pDb->db);
drhcabb0812002-09-14 13:47:32 +0000257 while( pDb->pFunc ){
258 SqlFunc *pFunc = pDb->pFunc;
259 pDb->pFunc = pFunc->pNext;
260 Tcl_Free((char*)pFunc);
261 }
drhbec3f402000-08-04 13:49:02 +0000262 if( pDb->zBusy ){
263 Tcl_Free(pDb->zBusy);
264 }
drhb5a20d32003-04-23 12:25:23 +0000265 if( pDb->zTrace ){
266 Tcl_Free(pDb->zTrace);
drh0d1a6432003-04-03 15:46:04 +0000267 }
drhe22a3342003-04-22 20:30:37 +0000268 if( pDb->zAuth ){
269 Tcl_Free(pDb->zAuth);
270 }
drhbec3f402000-08-04 13:49:02 +0000271 Tcl_Free((char*)pDb);
272}
273
274/*
275** This routine is called when a database file is locked while trying
276** to execute SQL.
277*/
278static int DbBusyHandler(void *cd, const char *zTable, int nTries){
279 SqliteDb *pDb = (SqliteDb*)cd;
280 int rc;
281 char zVal[30];
282 char *zCmd;
drhbec3f402000-08-04 13:49:02 +0000283 Tcl_DString cmd;
284
285 Tcl_DStringInit(&cmd);
286 Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
287 Tcl_DStringAppendElement(&cmd, zTable);
288 sprintf(zVal, " %d", nTries);
289 Tcl_DStringAppend(&cmd, zVal, -1);
290 zCmd = Tcl_DStringValue(&cmd);
291 rc = Tcl_Eval(pDb->interp, zCmd);
292 Tcl_DStringFree(&cmd);
293 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
294 return 0;
295 }
296 return 1;
drh75897232000-05-29 14:26:00 +0000297}
298
299/*
drhb5a20d32003-04-23 12:25:23 +0000300** This routine is called by the SQLite trace handler whenever a new
301** block of SQL is executed. The TCL script in pDb->zTrace is executed.
drh0d1a6432003-04-03 15:46:04 +0000302*/
drhb5a20d32003-04-23 12:25:23 +0000303static void DbTraceHandler(void *cd, const char *zSql){
drh0d1a6432003-04-03 15:46:04 +0000304 SqliteDb *pDb = (SqliteDb*)cd;
drhb5a20d32003-04-23 12:25:23 +0000305 Tcl_DString str;
drh0d1a6432003-04-03 15:46:04 +0000306
drhb5a20d32003-04-23 12:25:23 +0000307 Tcl_DStringInit(&str);
308 Tcl_DStringAppend(&str, pDb->zTrace, -1);
309 Tcl_DStringAppendElement(&str, zSql);
310 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
311 Tcl_DStringFree(&str);
312 Tcl_ResetResult(pDb->interp);
drh0d1a6432003-04-03 15:46:04 +0000313}
314
315/*
drhcabb0812002-09-14 13:47:32 +0000316** This routine is called to evaluate an SQL function implemented
317** using TCL script.
318*/
319static void tclSqlFunc(sqlite_func *context, int argc, const char **argv){
320 SqlFunc *p = sqlite_user_data(context);
321 Tcl_DString cmd;
322 int i;
323 int rc;
324
325 Tcl_DStringInit(&cmd);
326 Tcl_DStringAppend(&cmd, p->zScript, -1);
327 for(i=0; i<argc; i++){
328 Tcl_DStringAppendElement(&cmd, argv[i] ? argv[i] : "");
329 }
330 rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));
331 if( rc ){
332 sqlite_set_result_error(context, Tcl_GetStringResult(p->interp), -1);
333 }else{
334 sqlite_set_result_string(context, Tcl_GetStringResult(p->interp), -1);
335 }
336}
drhe22a3342003-04-22 20:30:37 +0000337#ifndef SQLITE_OMIT_AUTHORIZATION
338/*
339** This is the authentication function. It appends the authentication
340** type code and the two arguments to zCmd[] then invokes the result
341** on the interpreter. The reply is examined to determine if the
342** authentication fails or succeeds.
343*/
344static int auth_callback(
345 void *pArg,
346 int code,
347 const char *zArg1,
348 const char *zArg2,
349 const char *zArg3,
350 const char *zArg4
351){
352 char *zCode;
353 Tcl_DString str;
354 int rc;
355 const char *zReply;
356 SqliteDb *pDb = (SqliteDb*)pArg;
357
358 switch( code ){
359 case SQLITE_COPY : zCode="SQLITE_COPY"; break;
360 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
361 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
362 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
363 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
364 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
365 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
366 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
367 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
368 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
369 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
370 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
371 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
372 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
373 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
374 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
375 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
376 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
377 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
378 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
379 case SQLITE_READ : zCode="SQLITE_READ"; break;
380 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
381 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
382 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
drh81e293b2003-06-06 19:00:42 +0000383 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
384 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
drhe22a3342003-04-22 20:30:37 +0000385 default : zCode="????"; break;
386 }
387 Tcl_DStringInit(&str);
388 Tcl_DStringAppend(&str, pDb->zAuth, -1);
389 Tcl_DStringAppendElement(&str, zCode);
390 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
391 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
392 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
393 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
394 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
395 Tcl_DStringFree(&str);
396 zReply = Tcl_GetStringResult(pDb->interp);
397 if( strcmp(zReply,"SQLITE_OK")==0 ){
398 rc = SQLITE_OK;
399 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
400 rc = SQLITE_DENY;
401 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
402 rc = SQLITE_IGNORE;
403 }else{
404 rc = 999;
405 }
406 return rc;
407}
408#endif /* SQLITE_OMIT_AUTHORIZATION */
drhcabb0812002-09-14 13:47:32 +0000409
410/*
drh75897232000-05-29 14:26:00 +0000411** The "sqlite" command below creates a new Tcl command for each
412** connection it opens to an SQLite database. This routine is invoked
413** whenever one of those connection-specific commands is executed
414** in Tcl. For example, if you run Tcl code like this:
415**
416** sqlite db1 "my_database"
417** db1 close
418**
419** The first command opens a connection to the "my_database" database
420** and calls that connection "db1". The second command causes this
421** subroutine to be invoked.
422*/
drh6d313162000-09-21 13:01:35 +0000423static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
drhbec3f402000-08-04 13:49:02 +0000424 SqliteDb *pDb = (SqliteDb*)cd;
drh6d313162000-09-21 13:01:35 +0000425 int choice;
drh0de8c112002-07-06 16:32:14 +0000426 static const char *DB_strs[] = {
drhb5a20d32003-04-23 12:25:23 +0000427 "authorizer", "busy", "changes",
428 "close", "complete", "errorcode",
429 "eval", "function", "last_insert_rowid",
430 "timeout", "trace", 0
drh6d313162000-09-21 13:01:35 +0000431 };
drh411995d2002-06-25 19:31:18 +0000432 enum DB_enum {
drhb5a20d32003-04-23 12:25:23 +0000433 DB_AUTHORIZER, DB_BUSY, DB_CHANGES,
434 DB_CLOSE, DB_COMPLETE, DB_ERRORCODE,
435 DB_EVAL, DB_FUNCTION, DB_LAST_INSERT_ROWID,
436 DB_TIMEOUT, DB_TRACE,
drh6d313162000-09-21 13:01:35 +0000437 };
438
439 if( objc<2 ){
440 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
drh75897232000-05-29 14:26:00 +0000441 return TCL_ERROR;
442 }
drh411995d2002-06-25 19:31:18 +0000443 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
drh6d313162000-09-21 13:01:35 +0000444 return TCL_ERROR;
445 }
446
drh411995d2002-06-25 19:31:18 +0000447 switch( (enum DB_enum)choice ){
drh75897232000-05-29 14:26:00 +0000448
drhe22a3342003-04-22 20:30:37 +0000449 /* $db authorizer ?CALLBACK?
450 **
451 ** Invoke the given callback to authorize each SQL operation as it is
452 ** compiled. 5 arguments are appended to the callback before it is
453 ** invoked:
454 **
455 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
456 ** (2) First descriptive name (depends on authorization type)
457 ** (3) Second descriptive name
458 ** (4) Name of the database (ex: "main", "temp")
459 ** (5) Name of trigger that is doing the access
460 **
461 ** The callback should return on of the following strings: SQLITE_OK,
462 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
463 **
464 ** If this method is invoked with no arguments, the current authorization
465 ** callback string is returned.
466 */
467 case DB_AUTHORIZER: {
468 if( objc>3 ){
469 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
470 }else if( objc==2 ){
drhb5a20d32003-04-23 12:25:23 +0000471 if( pDb->zAuth ){
drhe22a3342003-04-22 20:30:37 +0000472 Tcl_AppendResult(interp, pDb->zAuth, 0);
473 }
474 }else{
475 char *zAuth;
476 int len;
477 if( pDb->zAuth ){
478 Tcl_Free(pDb->zAuth);
479 }
480 zAuth = Tcl_GetStringFromObj(objv[2], &len);
481 if( zAuth && len>0 ){
482 pDb->zAuth = Tcl_Alloc( len + 1 );
483 strcpy(pDb->zAuth, zAuth);
484 }else{
485 pDb->zAuth = 0;
486 }
487#ifndef SQLITE_OMIT_AUTHORIZATION
488 if( pDb->zAuth ){
489 pDb->interp = interp;
490 sqlite_set_authorizer(pDb->db, auth_callback, pDb);
491 }else{
492 sqlite_set_authorizer(pDb->db, 0, 0);
493 }
494#endif
495 }
496 break;
497 }
498
drhbec3f402000-08-04 13:49:02 +0000499 /* $db busy ?CALLBACK?
500 **
501 ** Invoke the given callback if an SQL statement attempts to open
502 ** a locked database file.
503 */
drh6d313162000-09-21 13:01:35 +0000504 case DB_BUSY: {
505 if( objc>3 ){
506 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
drhbec3f402000-08-04 13:49:02 +0000507 return TCL_ERROR;
drh6d313162000-09-21 13:01:35 +0000508 }else if( objc==2 ){
drhbec3f402000-08-04 13:49:02 +0000509 if( pDb->zBusy ){
510 Tcl_AppendResult(interp, pDb->zBusy, 0);
511 }
512 }else{
drh6d313162000-09-21 13:01:35 +0000513 char *zBusy;
514 int len;
drhbec3f402000-08-04 13:49:02 +0000515 if( pDb->zBusy ){
516 Tcl_Free(pDb->zBusy);
drhbec3f402000-08-04 13:49:02 +0000517 }
drh6d313162000-09-21 13:01:35 +0000518 zBusy = Tcl_GetStringFromObj(objv[2], &len);
519 if( zBusy && len>0 ){
520 pDb->zBusy = Tcl_Alloc( len + 1 );
521 strcpy(pDb->zBusy, zBusy);
522 }else{
523 pDb->zBusy = 0;
drhbec3f402000-08-04 13:49:02 +0000524 }
525 if( pDb->zBusy ){
526 pDb->interp = interp;
527 sqlite_busy_handler(pDb->db, DbBusyHandler, pDb);
drh6d313162000-09-21 13:01:35 +0000528 }else{
529 sqlite_busy_handler(pDb->db, 0, 0);
drhbec3f402000-08-04 13:49:02 +0000530 }
531 }
drh6d313162000-09-21 13:01:35 +0000532 break;
533 }
drhbec3f402000-08-04 13:49:02 +0000534
drhc8d30ac2002-04-12 10:08:59 +0000535 /*
536 ** $db changes
537 **
538 ** Return the number of rows that were modified, inserted, or deleted by
539 ** the most recent "eval".
540 */
541 case DB_CHANGES: {
542 Tcl_Obj *pResult;
543 int nChange;
544 if( objc!=2 ){
545 Tcl_WrongNumArgs(interp, 2, objv, "");
546 return TCL_ERROR;
547 }
548 nChange = sqlite_changes(pDb->db);
549 pResult = Tcl_GetObjResult(interp);
550 Tcl_SetIntObj(pResult, nChange);
551 break;
552 }
553
drh75897232000-05-29 14:26:00 +0000554 /* $db close
555 **
556 ** Shutdown the database
557 */
drh6d313162000-09-21 13:01:35 +0000558 case DB_CLOSE: {
559 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
560 break;
561 }
drh75897232000-05-29 14:26:00 +0000562
563 /* $db complete SQL
564 **
565 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
566 ** additional lines of input are needed. This is similar to the
567 ** built-in "info complete" command of Tcl.
568 */
drh6d313162000-09-21 13:01:35 +0000569 case DB_COMPLETE: {
570 Tcl_Obj *pResult;
571 int isComplete;
572 if( objc!=3 ){
573 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
drh75897232000-05-29 14:26:00 +0000574 return TCL_ERROR;
575 }
drh6d313162000-09-21 13:01:35 +0000576 isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) );
577 pResult = Tcl_GetObjResult(interp);
578 Tcl_SetBooleanObj(pResult, isComplete);
579 break;
580 }
drhdcd997e2003-01-31 17:21:49 +0000581
582 /*
583 ** $db errorcode
584 **
585 ** Return the numeric error code that was returned by the most recent
586 ** call to sqlite_exec().
587 */
588 case DB_ERRORCODE: {
589 Tcl_SetObjResult(interp, Tcl_NewIntObj(pDb->rc));
590 break;
591 }
drh75897232000-05-29 14:26:00 +0000592
593 /*
594 ** $db eval $sql ?array { ...code... }?
595 **
596 ** The SQL statement in $sql is evaluated. For each row, the values are
drhbec3f402000-08-04 13:49:02 +0000597 ** placed in elements of the array named "array" and ...code... is executed.
drh75897232000-05-29 14:26:00 +0000598 ** If "array" and "code" are omitted, then no callback is every invoked.
599 ** If "array" is an empty string, then the values are placed in variables
600 ** that have the same name as the fields extracted by the query.
601 */
drh6d313162000-09-21 13:01:35 +0000602 case DB_EVAL: {
drh75897232000-05-29 14:26:00 +0000603 CallbackData cbData;
604 char *zErrMsg;
drh6d313162000-09-21 13:01:35 +0000605 char *zSql;
drh75897232000-05-29 14:26:00 +0000606 int rc;
drh297ecf12001-04-05 15:57:13 +0000607#ifdef UTF_TRANSLATION_NEEDED
608 Tcl_DString dSql;
drh6d4abfb2001-10-22 02:58:08 +0000609 int i;
drh297ecf12001-04-05 15:57:13 +0000610#endif
drh75897232000-05-29 14:26:00 +0000611
drh6d313162000-09-21 13:01:35 +0000612 if( objc!=5 && objc!=3 ){
613 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?");
drh75897232000-05-29 14:26:00 +0000614 return TCL_ERROR;
615 }
drhbec3f402000-08-04 13:49:02 +0000616 pDb->interp = interp;
drh6d313162000-09-21 13:01:35 +0000617 zSql = Tcl_GetStringFromObj(objv[2], 0);
drh297ecf12001-04-05 15:57:13 +0000618#ifdef UTF_TRANSLATION_NEEDED
619 Tcl_DStringInit(&dSql);
620 Tcl_UtfToExternalDString(NULL, zSql, -1, &dSql);
621 zSql = Tcl_DStringValue(&dSql);
622#endif
drh6d313162000-09-21 13:01:35 +0000623 Tcl_IncrRefCount(objv[2]);
624 if( objc==5 ){
drh75897232000-05-29 14:26:00 +0000625 cbData.interp = interp;
drhdcc581c2000-05-30 13:44:19 +0000626 cbData.once = 1;
drh6d313162000-09-21 13:01:35 +0000627 cbData.zArray = Tcl_GetStringFromObj(objv[3], 0);
628 cbData.pCode = objv[4];
drh960e8c62001-04-03 16:53:21 +0000629 cbData.tcl_rc = TCL_OK;
drh6d4abfb2001-10-22 02:58:08 +0000630 cbData.nColName = 0;
631 cbData.azColName = 0;
drh75897232000-05-29 14:26:00 +0000632 zErrMsg = 0;
drh6d313162000-09-21 13:01:35 +0000633 Tcl_IncrRefCount(objv[3]);
634 Tcl_IncrRefCount(objv[4]);
635 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg);
636 Tcl_DecrRefCount(objv[4]);
637 Tcl_DecrRefCount(objv[3]);
drh960e8c62001-04-03 16:53:21 +0000638 if( cbData.tcl_rc==TCL_BREAK ){ cbData.tcl_rc = TCL_OK; }
drh75897232000-05-29 14:26:00 +0000639 }else{
drh6d313162000-09-21 13:01:35 +0000640 Tcl_Obj *pList = Tcl_NewObj();
drh960e8c62001-04-03 16:53:21 +0000641 cbData.tcl_rc = TCL_OK;
drh6d313162000-09-21 13:01:35 +0000642 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg);
643 Tcl_SetObjResult(interp, pList);
drh75897232000-05-29 14:26:00 +0000644 }
drhdcd997e2003-01-31 17:21:49 +0000645 pDb->rc = rc;
drhb798fa62002-09-03 19:43:23 +0000646 if( rc==SQLITE_ABORT ){
647 if( zErrMsg ) free(zErrMsg);
648 rc = cbData.tcl_rc;
649 }else if( zErrMsg ){
drh75897232000-05-29 14:26:00 +0000650 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
651 free(zErrMsg);
drh960e8c62001-04-03 16:53:21 +0000652 rc = TCL_ERROR;
drhb798fa62002-09-03 19:43:23 +0000653 }else if( rc!=SQLITE_OK ){
drh6d4abfb2001-10-22 02:58:08 +0000654 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
655 rc = TCL_ERROR;
drh960e8c62001-04-03 16:53:21 +0000656 }else{
drh75897232000-05-29 14:26:00 +0000657 }
drh6d313162000-09-21 13:01:35 +0000658 Tcl_DecrRefCount(objv[2]);
drh297ecf12001-04-05 15:57:13 +0000659#ifdef UTF_TRANSLATION_NEEDED
660 Tcl_DStringFree(&dSql);
drh6d4abfb2001-10-22 02:58:08 +0000661 if( objc==5 && cbData.azColName ){
662 for(i=0; i<cbData.nColName; i++){
663 if( cbData.azColName[i] ) free(cbData.azColName[i]);
664 }
665 free(cbData.azColName);
drhce927062001-11-09 13:41:09 +0000666 cbData.azColName = 0;
drh6d4abfb2001-10-22 02:58:08 +0000667 }
drh297ecf12001-04-05 15:57:13 +0000668#endif
drh75897232000-05-29 14:26:00 +0000669 return rc;
drh6d313162000-09-21 13:01:35 +0000670 }
drhbec3f402000-08-04 13:49:02 +0000671
672 /*
drhcabb0812002-09-14 13:47:32 +0000673 ** $db function NAME SCRIPT
674 **
675 ** Create a new SQL function called NAME. Whenever that function is
676 ** called, invoke SCRIPT to evaluate the function.
677 */
678 case DB_FUNCTION: {
679 SqlFunc *pFunc;
680 char *zName;
681 char *zScript;
682 int nScript;
683 if( objc!=4 ){
684 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
685 return TCL_ERROR;
686 }
687 zName = Tcl_GetStringFromObj(objv[2], 0);
688 zScript = Tcl_GetStringFromObj(objv[3], &nScript);
689 pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
690 if( pFunc==0 ) return TCL_ERROR;
691 pFunc->interp = interp;
692 pFunc->pNext = pDb->pFunc;
693 pFunc->zScript = (char*)&pFunc[1];
694 strcpy(pFunc->zScript, zScript);
695 sqlite_create_function(pDb->db, zName, -1, tclSqlFunc, pFunc);
696 sqlite_function_type(pDb->db, zName, SQLITE_NUMERIC);
697 break;
698 }
699
700 /*
drhaf9ff332002-01-16 21:00:27 +0000701 ** $db last_insert_rowid
702 **
703 ** Return an integer which is the ROWID for the most recent insert.
704 */
705 case DB_LAST_INSERT_ROWID: {
706 Tcl_Obj *pResult;
707 int rowid;
708 if( objc!=2 ){
709 Tcl_WrongNumArgs(interp, 2, objv, "");
710 return TCL_ERROR;
711 }
712 rowid = sqlite_last_insert_rowid(pDb->db);
713 pResult = Tcl_GetObjResult(interp);
714 Tcl_SetIntObj(pResult, rowid);
715 break;
716 }
717
718 /*
drhbec3f402000-08-04 13:49:02 +0000719 ** $db timeout MILLESECONDS
720 **
721 ** Delay for the number of milliseconds specified when a file is locked.
722 */
drh6d313162000-09-21 13:01:35 +0000723 case DB_TIMEOUT: {
drhbec3f402000-08-04 13:49:02 +0000724 int ms;
drh6d313162000-09-21 13:01:35 +0000725 if( objc!=3 ){
726 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
drhbec3f402000-08-04 13:49:02 +0000727 return TCL_ERROR;
728 }
drh6d313162000-09-21 13:01:35 +0000729 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
drhbec3f402000-08-04 13:49:02 +0000730 sqlite_busy_timeout(pDb->db, ms);
drh6d313162000-09-21 13:01:35 +0000731 break;
drh75897232000-05-29 14:26:00 +0000732 }
drhb5a20d32003-04-23 12:25:23 +0000733
734 /* $db trace ?CALLBACK?
735 **
736 ** Make arrangements to invoke the CALLBACK routine for each SQL statement
737 ** that is executed. The text of the SQL is appended to CALLBACK before
738 ** it is executed.
739 */
740 case DB_TRACE: {
741 if( objc>3 ){
742 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
743 }else if( objc==2 ){
744 if( pDb->zTrace ){
745 Tcl_AppendResult(interp, pDb->zTrace, 0);
746 }
747 }else{
748 char *zTrace;
749 int len;
750 if( pDb->zTrace ){
751 Tcl_Free(pDb->zTrace);
752 }
753 zTrace = Tcl_GetStringFromObj(objv[2], &len);
754 if( zTrace && len>0 ){
755 pDb->zTrace = Tcl_Alloc( len + 1 );
756 strcpy(pDb->zTrace, zTrace);
757 }else{
758 pDb->zTrace = 0;
759 }
760 if( pDb->zTrace ){
761 pDb->interp = interp;
762 sqlite_trace(pDb->db, DbTraceHandler, pDb);
763 }else{
764 sqlite_trace(pDb->db, 0, 0);
765 }
766 }
767 break;
768 }
769
drh6d313162000-09-21 13:01:35 +0000770 } /* End of the SWITCH statement */
drh75897232000-05-29 14:26:00 +0000771 return TCL_OK;
772}
773
774/*
775** sqlite DBNAME FILENAME ?MODE?
776**
777** This is the main Tcl command. When the "sqlite" Tcl command is
778** invoked, this routine runs to process that command.
779**
780** The first argument, DBNAME, is an arbitrary name for a new
781** database connection. This command creates a new command named
782** DBNAME that is used to control that connection. The database
783** connection is deleted when the DBNAME command is deleted.
784**
785** The second argument is the name of the directory that contains
786** the sqlite database that is to be accessed.
drhfbc3eab2001-04-06 16:13:42 +0000787**
788** For testing purposes, we also support the following:
789**
790** sqlite -encoding
791**
792** Return the encoding used by LIKE and GLOB operators. Choices
793** are UTF-8 and iso8859.
794**
drh647cb0e2002-11-04 19:32:25 +0000795** sqlite -version
796**
797** Return the version number of the SQLite library.
798**
drhfbc3eab2001-04-06 16:13:42 +0000799** sqlite -tcl-uses-utf
800**
801** Return "1" if compiled with a Tcl uses UTF-8. Return "0" if
802** not. Used by tests to make sure the library was compiled
803** correctly.
drh75897232000-05-29 14:26:00 +0000804*/
805static int DbMain(void *cd, Tcl_Interp *interp, int argc, char **argv){
806 int mode;
drhbec3f402000-08-04 13:49:02 +0000807 SqliteDb *p;
drh75897232000-05-29 14:26:00 +0000808 char *zErrMsg;
drh06b27182002-06-26 20:06:05 +0000809 char zBuf[80];
drhfbc3eab2001-04-06 16:13:42 +0000810 if( argc==2 ){
811 if( strcmp(argv[1],"-encoding")==0 ){
812 Tcl_AppendResult(interp,sqlite_encoding,0);
813 return TCL_OK;
814 }
drh647cb0e2002-11-04 19:32:25 +0000815 if( strcmp(argv[1],"-version")==0 ){
816 Tcl_AppendResult(interp,sqlite_version,0);
817 return TCL_OK;
818 }
drhfbc3eab2001-04-06 16:13:42 +0000819 if( strcmp(argv[1],"-tcl-uses-utf")==0 ){
820#ifdef TCL_UTF_MAX
821 Tcl_AppendResult(interp,"1",0);
822#else
823 Tcl_AppendResult(interp,"0",0);
824#endif
825 return TCL_OK;
826 }
827 }
drh75897232000-05-29 14:26:00 +0000828 if( argc!=3 && argc!=4 ){
829 Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0],
830 " HANDLE FILENAME ?MODE?\"", 0);
831 return TCL_ERROR;
832 }
833 if( argc==3 ){
drh58b95762000-06-02 01:17:37 +0000834 mode = 0666;
drh75897232000-05-29 14:26:00 +0000835 }else if( Tcl_GetInt(interp, argv[3], &mode)!=TCL_OK ){
836 return TCL_ERROR;
837 }
838 zErrMsg = 0;
drh4cdc9e82000-08-04 14:56:24 +0000839 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
drh75897232000-05-29 14:26:00 +0000840 if( p==0 ){
drhbec3f402000-08-04 13:49:02 +0000841 Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
842 return TCL_ERROR;
843 }
844 memset(p, 0, sizeof(*p));
845 p->db = sqlite_open(argv[2], mode, &zErrMsg);
846 if( p->db==0 ){
drh75897232000-05-29 14:26:00 +0000847 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
drhbec3f402000-08-04 13:49:02 +0000848 Tcl_Free((char*)p);
drh75897232000-05-29 14:26:00 +0000849 free(zErrMsg);
850 return TCL_ERROR;
851 }
drh6d313162000-09-21 13:01:35 +0000852 Tcl_CreateObjCommand(interp, argv[1], DbObjCmd, (char*)p, DbDeleteCmd);
drhc22bd472002-05-10 13:14:07 +0000853
drh06b27182002-06-26 20:06:05 +0000854 /* The return value is the value of the sqlite* pointer
855 */
856 sprintf(zBuf, "%p", p->db);
drh5e5377f2002-07-07 17:12:36 +0000857 if( strncmp(zBuf,"0x",2) ){
858 sprintf(zBuf, "0x%p", p->db);
859 }
drh06b27182002-06-26 20:06:05 +0000860 Tcl_AppendResult(interp, zBuf, 0);
861
drhc22bd472002-05-10 13:14:07 +0000862 /* If compiled with SQLITE_TEST turned on, then register the "md5sum"
drh06b27182002-06-26 20:06:05 +0000863 ** SQL function.
drhc22bd472002-05-10 13:14:07 +0000864 */
drh28b4e482002-03-11 02:06:13 +0000865#ifdef SQLITE_TEST
866 {
drhc22bd472002-05-10 13:14:07 +0000867 extern void Md5_Register(sqlite*);
868 Md5_Register(p->db);
drh06b27182002-06-26 20:06:05 +0000869 }
drh28b4e482002-03-11 02:06:13 +0000870#endif
drh75897232000-05-29 14:26:00 +0000871 return TCL_OK;
872}
873
874/*
drh90ca9752001-09-28 17:47:14 +0000875** Provide a dummy Tcl_InitStubs if we are using this as a static
876** library.
877*/
878#ifndef USE_TCL_STUBS
879# undef Tcl_InitStubs
880# define Tcl_InitStubs(a,b,c)
881#endif
882
883/*
drh75897232000-05-29 14:26:00 +0000884** Initialize this module.
885**
886** This Tcl module contains only a single new Tcl command named "sqlite".
887** (Hence there is no namespace. There is no point in using a namespace
888** if the extension only supplies one new name!) The "sqlite" command is
889** used to open a new SQLite database. See the DbMain() routine above
890** for additional information.
891*/
892int Sqlite_Init(Tcl_Interp *interp){
drh90ca9752001-09-28 17:47:14 +0000893 Tcl_InitStubs(interp, "8.0", 0);
drhc2eef3b2002-08-31 18:53:06 +0000894 Tcl_CreateCommand(interp, "sqlite", (Tcl_CmdProc*)DbMain, 0, 0);
drh6d4abfb2001-10-22 02:58:08 +0000895 Tcl_PkgProvide(interp, "sqlite", "2.0");
drh90ca9752001-09-28 17:47:14 +0000896 return TCL_OK;
897}
898int Tclsqlite_Init(Tcl_Interp *interp){
899 Tcl_InitStubs(interp, "8.0", 0);
drhc2eef3b2002-08-31 18:53:06 +0000900 Tcl_CreateCommand(interp, "sqlite", (Tcl_CmdProc*)DbMain, 0, 0);
drh6d4abfb2001-10-22 02:58:08 +0000901 Tcl_PkgProvide(interp, "sqlite", "2.0");
drh75897232000-05-29 14:26:00 +0000902 return TCL_OK;
903}
904int Sqlite_SafeInit(Tcl_Interp *interp){
905 return TCL_OK;
906}
drh90ca9752001-09-28 17:47:14 +0000907int Tclsqlite_SafeInit(Tcl_Interp *interp){
908 return TCL_OK;
909}
drh75897232000-05-29 14:26:00 +0000910
drh3cebbde2000-10-19 14:59:27 +0000911#if 0
drh75897232000-05-29 14:26:00 +0000912/*
913** If compiled using mktclapp, this routine runs to initialize
914** everything.
915*/
916int Et_AppInit(Tcl_Interp *interp){
917 return Sqlite_Init(interp);
918}
drh3cebbde2000-10-19 14:59:27 +0000919#endif
drh348784e2000-05-29 20:41:49 +0000920
921/*
922** If the macro TCLSH is defined and is one, then put in code for the
923** "main" routine that will initialize Tcl.
924*/
925#if defined(TCLSH) && TCLSH==1
926static char zMainloop[] =
927 "set line {}\n"
928 "while {![eof stdin]} {\n"
929 "if {$line!=\"\"} {\n"
930 "puts -nonewline \"> \"\n"
931 "} else {\n"
932 "puts -nonewline \"% \"\n"
933 "}\n"
934 "flush stdout\n"
935 "append line [gets stdin]\n"
936 "if {[info complete $line]} {\n"
937 "if {[catch {uplevel #0 $line} result]} {\n"
938 "puts stderr \"Error: $result\"\n"
939 "} elseif {$result!=\"\"} {\n"
940 "puts $result\n"
941 "}\n"
942 "set line {}\n"
943 "} else {\n"
944 "append line \\n\n"
945 "}\n"
946 "}\n"
947;
948
949#define TCLSH_MAIN main /* Needed to fake out mktclapp */
950int TCLSH_MAIN(int argc, char **argv){
951 Tcl_Interp *interp;
drh297ecf12001-04-05 15:57:13 +0000952 Tcl_FindExecutable(argv[0]);
drh348784e2000-05-29 20:41:49 +0000953 interp = Tcl_CreateInterp();
954 Sqlite_Init(interp);
drhd9b02572001-04-15 00:37:09 +0000955#ifdef SQLITE_TEST
drhd1bf3512001-04-07 15:24:33 +0000956 {
957 extern int Sqlitetest1_Init(Tcl_Interp*);
drh5c4d9702001-08-20 00:33:58 +0000958 extern int Sqlitetest2_Init(Tcl_Interp*);
959 extern int Sqlitetest3_Init(Tcl_Interp*);
drhefc251d2001-07-01 22:12:01 +0000960 extern int Md5_Init(Tcl_Interp*);
drhd1bf3512001-04-07 15:24:33 +0000961 Sqlitetest1_Init(interp);
drh5c4d9702001-08-20 00:33:58 +0000962 Sqlitetest2_Init(interp);
963 Sqlitetest3_Init(interp);
drhefc251d2001-07-01 22:12:01 +0000964 Md5_Init(interp);
drhd1bf3512001-04-07 15:24:33 +0000965 }
966#endif
drh348784e2000-05-29 20:41:49 +0000967 if( argc>=2 ){
968 int i;
969 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
970 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
971 for(i=2; i<argc; i++){
972 Tcl_SetVar(interp, "argv", argv[i],
973 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
974 }
975 if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
drh0de8c112002-07-06 16:32:14 +0000976 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
drhc61053b2000-06-04 12:58:36 +0000977 if( zInfo==0 ) zInfo = interp->result;
978 fprintf(stderr,"%s: %s\n", *argv, zInfo);
drh348784e2000-05-29 20:41:49 +0000979 return 1;
980 }
981 }else{
982 Tcl_GlobalEval(interp, zMainloop);
983 }
984 return 0;
985}
986#endif /* TCLSH */
drh6d313162000-09-21 13:01:35 +0000987
988#endif /* !defined(NO_TCL) */