1 /*
2 ** 2001 September 15
3 **
4 ** The author disclaims copyright to this source code. In place of
5 ** a legal notice, here is a blessing:
6 **
7 ** 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.
10 **
11 *************************************************************************
12 ** A TCL Interface to SQLite
13 **
14 ** $Id: tclsqlite.c,v 1.59.2.1 2004/06/19 11:57:40 drh Exp $
15 */
16 #ifndef NO_TCL /* Omit this whole file if TCL is unavailable */
17
18 #include "sqliteInt.h"
19 #include "tcl.h"
20 #include <stdlib.h>
21 #include <string.h>
22 #include <assert.h>
23
24 /*
25 ** 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 /*
35 ** New SQL functions can be created as TCL scripts. Each such function
36 ** is described by an instance of the following structure.
37 */
38 typedef struct SqlFunc SqlFunc;
39 struct 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 /*
46 ** There is one instance of this structure for each SQLite database
47 ** that has been opened by the SQLite TCL interface.
48 */
49 typedef struct SqliteDb SqliteDb;
50 struct SqliteDb {
51 sqlite *db; /* The "real" database structure */
52 Tcl_Interp *interp; /* The interpreter used for this database */
53 char *zBusy; /* The busy callback routine */
54 char *zCommit; /* The commit hook callback routine */
55 char *zTrace; /* The trace callback routine */
56 char *zProgress; /* The progress callback routine */
57 char *zAuth; /* The authorization callback routine */
58 SqlFunc *pFunc; /* List of SQL functions */
59 int rc; /* Return code of most recent sqlite_exec() */
60 };
61
62 /*
63 ** An instance of this structure passes information thru the sqlite
64 ** logic from the original TCL command into the callback routine.
65 */
66 typedef struct CallbackData CallbackData;
67 struct CallbackData {
68 Tcl_Interp *interp; /* The TCL interpreter */
69 char *zArray; /* The array into which data is written */
70 Tcl_Obj *pCode; /* The code to execute for each row */
71 int once; /* Set for first callback only */
72 int tcl_rc; /* Return code from TCL script */
73 int nColName; /* Number of entries in the azColName[] array */
74 char **azColName; /* Column names translated to UTF-8 */
75 };
76
77 #ifdef UTF_TRANSLATION_NEEDED
78 /*
79 ** Called for each row of the result.
80 **
81 ** This version is used when TCL expects UTF-8 data but the database
82 ** uses the ISO8859 format. A translation must occur from ISO8859 into
83 ** UTF-8.
84 */
DbEvalCallback(void * clientData,int nCol,char ** azCol,char ** azN)85 static int DbEvalCallback(
86 void *clientData, /* An instance of CallbackData */
87 int nCol, /* Number of columns in the result */
88 char ** azCol, /* Data for each column */
89 char ** azN /* Name for each column */
90 ){
91 CallbackData *cbData = (CallbackData*)clientData;
92 int i, rc;
93 Tcl_DString dCol;
94 Tcl_DStringInit(&dCol);
95 if( cbData->azColName==0 ){
96 assert( cbData->once );
97 cbData->once = 0;
98 if( cbData->zArray[0] ){
99 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
100 }
101 cbData->azColName = malloc( nCol*sizeof(char*) );
102 if( cbData->azColName==0 ){ return 1; }
103 cbData->nColName = nCol;
104 for(i=0; i<nCol; i++){
105 Tcl_ExternalToUtfDString(NULL, azN[i], -1, &dCol);
106 cbData->azColName[i] = malloc( Tcl_DStringLength(&dCol) + 1 );
107 if( cbData->azColName[i] ){
108 strcpy(cbData->azColName[i], Tcl_DStringValue(&dCol));
109 }else{
110 return 1;
111 }
112 if( cbData->zArray[0] ){
113 Tcl_SetVar2(cbData->interp, cbData->zArray, "*",
114 Tcl_DStringValue(&dCol), TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
115 if( azN[nCol]!=0 ){
116 Tcl_DString dType;
117 Tcl_DStringInit(&dType);
118 Tcl_DStringAppend(&dType, "typeof:", -1);
119 Tcl_DStringAppend(&dType, Tcl_DStringValue(&dCol), -1);
120 Tcl_DStringFree(&dCol);
121 Tcl_ExternalToUtfDString(NULL, azN[i+nCol], -1, &dCol);
122 Tcl_SetVar2(cbData->interp, cbData->zArray,
123 Tcl_DStringValue(&dType), Tcl_DStringValue(&dCol),
124 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
125 Tcl_DStringFree(&dType);
126 }
127 }
128
129 Tcl_DStringFree(&dCol);
130 }
131 }
132 if( azCol!=0 ){
133 if( cbData->zArray[0] ){
134 for(i=0; i<nCol; i++){
135 char *z = azCol[i];
136 if( z==0 ) z = "";
137 Tcl_DStringInit(&dCol);
138 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
139 Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i],
140 Tcl_DStringValue(&dCol), 0);
141 Tcl_DStringFree(&dCol);
142 }
143 }else{
144 for(i=0; i<nCol; i++){
145 char *z = azCol[i];
146 if( z==0 ) z = "";
147 Tcl_DStringInit(&dCol);
148 Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
149 Tcl_SetVar(cbData->interp, cbData->azColName[i],
150 Tcl_DStringValue(&dCol), 0);
151 Tcl_DStringFree(&dCol);
152 }
153 }
154 }
155 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
156 if( rc==TCL_CONTINUE ) rc = TCL_OK;
157 cbData->tcl_rc = rc;
158 return rc!=TCL_OK;
159 }
160 #endif /* UTF_TRANSLATION_NEEDED */
161
162 #ifndef UTF_TRANSLATION_NEEDED
163 /*
164 ** Called for each row of the result.
165 **
166 ** This version is used when either of the following is true:
167 **
168 ** (1) This version of TCL uses UTF-8 and the data in the
169 ** SQLite database is already in the UTF-8 format.
170 **
171 ** (2) This version of TCL uses ISO8859 and the data in the
172 ** SQLite database is already in the ISO8859 format.
173 */
DbEvalCallback(void * clientData,int nCol,char ** azCol,char ** azN)174 static int DbEvalCallback(
175 void *clientData, /* An instance of CallbackData */
176 int nCol, /* Number of columns in the result */
177 char ** azCol, /* Data for each column */
178 char ** azN /* Name for each column */
179 ){
180 CallbackData *cbData = (CallbackData*)clientData;
181 int i, rc;
182 if( azCol==0 || (cbData->once && cbData->zArray[0]) ){
183 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
184 for(i=0; i<nCol; i++){
185 Tcl_SetVar2(cbData->interp, cbData->zArray, "*", azN[i],
186 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
187 if( azN[nCol] ){
188 char *z = sqlite_mprintf("typeof:%s", azN[i]);
189 Tcl_SetVar2(cbData->interp, cbData->zArray, z, azN[i+nCol],
190 TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
191 sqlite_freemem(z);
192 }
193 }
194 cbData->once = 0;
195 }
196 if( azCol!=0 ){
197 if( cbData->zArray[0] ){
198 for(i=0; i<nCol; i++){
199 char *z = azCol[i];
200 if( z==0 ) z = "";
201 Tcl_SetVar2(cbData->interp, cbData->zArray, azN[i], z, 0);
202 }
203 }else{
204 for(i=0; i<nCol; i++){
205 char *z = azCol[i];
206 if( z==0 ) z = "";
207 Tcl_SetVar(cbData->interp, azN[i], z, 0);
208 }
209 }
210 }
211 rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
212 if( rc==TCL_CONTINUE ) rc = TCL_OK;
213 cbData->tcl_rc = rc;
214 return rc!=TCL_OK;
215 }
216 #endif
217
218 /*
219 ** This is an alternative callback for database queries. Instead
220 ** of invoking a TCL script to handle the result, this callback just
221 ** appends each column of the result to a list. After the query
222 ** is complete, the list is returned.
223 */
DbEvalCallback2(void * clientData,int nCol,char ** azCol,char ** azN)224 static int DbEvalCallback2(
225 void *clientData, /* An instance of CallbackData */
226 int nCol, /* Number of columns in the result */
227 char ** azCol, /* Data for each column */
228 char ** azN /* Name for each column */
229 ){
230 Tcl_Obj *pList = (Tcl_Obj*)clientData;
231 int i;
232 if( azCol==0 ) return 0;
233 for(i=0; i<nCol; i++){
234 Tcl_Obj *pElem;
235 if( azCol[i] && *azCol[i] ){
236 #ifdef UTF_TRANSLATION_NEEDED
237 Tcl_DString dCol;
238 Tcl_DStringInit(&dCol);
239 Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol);
240 pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
241 Tcl_DStringFree(&dCol);
242 #else
243 pElem = Tcl_NewStringObj(azCol[i], -1);
244 #endif
245 }else{
246 pElem = Tcl_NewObj();
247 }
248 Tcl_ListObjAppendElement(0, pList, pElem);
249 }
250 return 0;
251 }
252
253 /*
254 ** This is a second alternative callback for database queries. A the
255 ** first column of the first row of the result is made the TCL result.
256 */
DbEvalCallback3(void * clientData,int nCol,char ** azCol,char ** azN)257 static int DbEvalCallback3(
258 void *clientData, /* An instance of CallbackData */
259 int nCol, /* Number of columns in the result */
260 char ** azCol, /* Data for each column */
261 char ** azN /* Name for each column */
262 ){
263 Tcl_Interp *interp = (Tcl_Interp*)clientData;
264 Tcl_Obj *pElem;
265 if( azCol==0 ) return 1;
266 if( nCol==0 ) return 1;
267 #ifdef UTF_TRANSLATION_NEEDED
268 {
269 Tcl_DString dCol;
270 Tcl_DStringInit(&dCol);
271 Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);
272 pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
273 Tcl_DStringFree(&dCol);
274 }
275 #else
276 pElem = Tcl_NewStringObj(azCol[0], -1);
277 #endif
278 Tcl_SetObjResult(interp, pElem);
279 return 1;
280 }
281
282 /*
283 ** Called when the command is deleted.
284 */
DbDeleteCmd(void * db)285 static void DbDeleteCmd(void *db){
286 SqliteDb *pDb = (SqliteDb*)db;
287 sqlite_close(pDb->db);
288 while( pDb->pFunc ){
289 SqlFunc *pFunc = pDb->pFunc;
290 pDb->pFunc = pFunc->pNext;
291 Tcl_Free((char*)pFunc);
292 }
293 if( pDb->zBusy ){
294 Tcl_Free(pDb->zBusy);
295 }
296 if( pDb->zTrace ){
297 Tcl_Free(pDb->zTrace);
298 }
299 if( pDb->zAuth ){
300 Tcl_Free(pDb->zAuth);
301 }
302 Tcl_Free((char*)pDb);
303 }
304
305 /*
306 ** This routine is called when a database file is locked while trying
307 ** to execute SQL.
308 */
DbBusyHandler(void * cd,const char * zTable,int nTries)309 static int DbBusyHandler(void *cd, const char *zTable, int nTries){
310 SqliteDb *pDb = (SqliteDb*)cd;
311 int rc;
312 char zVal[30];
313 char *zCmd;
314 Tcl_DString cmd;
315
316 Tcl_DStringInit(&cmd);
317 Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
318 Tcl_DStringAppendElement(&cmd, zTable);
319 sprintf(zVal, " %d", nTries);
320 Tcl_DStringAppend(&cmd, zVal, -1);
321 zCmd = Tcl_DStringValue(&cmd);
322 rc = Tcl_Eval(pDb->interp, zCmd);
323 Tcl_DStringFree(&cmd);
324 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
325 return 0;
326 }
327 return 1;
328 }
329
330 /*
331 ** This routine is invoked as the 'progress callback' for the database.
332 */
DbProgressHandler(void * cd)333 static int DbProgressHandler(void *cd){
334 SqliteDb *pDb = (SqliteDb*)cd;
335 int rc;
336
337 assert( pDb->zProgress );
338 rc = Tcl_Eval(pDb->interp, pDb->zProgress);
339 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
340 return 1;
341 }
342 return 0;
343 }
344
345 /*
346 ** This routine is called by the SQLite trace handler whenever a new
347 ** block of SQL is executed. The TCL script in pDb->zTrace is executed.
348 */
DbTraceHandler(void * cd,const char * zSql)349 static void DbTraceHandler(void *cd, const char *zSql){
350 SqliteDb *pDb = (SqliteDb*)cd;
351 Tcl_DString str;
352
353 Tcl_DStringInit(&str);
354 Tcl_DStringAppend(&str, pDb->zTrace, -1);
355 Tcl_DStringAppendElement(&str, zSql);
356 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
357 Tcl_DStringFree(&str);
358 Tcl_ResetResult(pDb->interp);
359 }
360
361 /*
362 ** This routine is called when a transaction is committed. The
363 ** TCL script in pDb->zCommit is executed. If it returns non-zero or
364 ** if it throws an exception, the transaction is rolled back instead
365 ** of being committed.
366 */
DbCommitHandler(void * cd)367 static int DbCommitHandler(void *cd){
368 SqliteDb *pDb = (SqliteDb*)cd;
369 int rc;
370
371 rc = Tcl_Eval(pDb->interp, pDb->zCommit);
372 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
373 return 1;
374 }
375 return 0;
376 }
377
378 /*
379 ** This routine is called to evaluate an SQL function implemented
380 ** using TCL script.
381 */
tclSqlFunc(sqlite_func * context,int argc,const char ** argv)382 static void tclSqlFunc(sqlite_func *context, int argc, const char **argv){
383 SqlFunc *p = sqlite_user_data(context);
384 Tcl_DString cmd;
385 int i;
386 int rc;
387
388 Tcl_DStringInit(&cmd);
389 Tcl_DStringAppend(&cmd, p->zScript, -1);
390 for(i=0; i<argc; i++){
391 Tcl_DStringAppendElement(&cmd, argv[i] ? argv[i] : "");
392 }
393 rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));
394 if( rc ){
395 sqlite_set_result_error(context, Tcl_GetStringResult(p->interp), -1);
396 }else{
397 sqlite_set_result_string(context, Tcl_GetStringResult(p->interp), -1);
398 }
399 }
400 #ifndef SQLITE_OMIT_AUTHORIZATION
401 /*
402 ** This is the authentication function. It appends the authentication
403 ** type code and the two arguments to zCmd[] then invokes the result
404 ** on the interpreter. The reply is examined to determine if the
405 ** authentication fails or succeeds.
406 */
auth_callback(void * pArg,int code,const char * zArg1,const char * zArg2,const char * zArg3,const char * zArg4)407 static int auth_callback(
408 void *pArg,
409 int code,
410 const char *zArg1,
411 const char *zArg2,
412 const char *zArg3,
413 const char *zArg4
414 ){
415 char *zCode;
416 Tcl_DString str;
417 int rc;
418 const char *zReply;
419 SqliteDb *pDb = (SqliteDb*)pArg;
420
421 switch( code ){
422 case SQLITE_COPY : zCode="SQLITE_COPY"; break;
423 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
424 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
425 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
426 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
427 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
428 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
429 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
430 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
431 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
432 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
433 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
434 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
435 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
436 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
437 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
438 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
439 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
440 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
441 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
442 case SQLITE_READ : zCode="SQLITE_READ"; break;
443 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
444 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
445 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
446 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
447 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
448 default : zCode="????"; break;
449 }
450 Tcl_DStringInit(&str);
451 Tcl_DStringAppend(&str, pDb->zAuth, -1);
452 Tcl_DStringAppendElement(&str, zCode);
453 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
454 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
455 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
456 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
457 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
458 Tcl_DStringFree(&str);
459 zReply = Tcl_GetStringResult(pDb->interp);
460 if( strcmp(zReply,"SQLITE_OK")==0 ){
461 rc = SQLITE_OK;
462 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
463 rc = SQLITE_DENY;
464 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
465 rc = SQLITE_IGNORE;
466 }else{
467 rc = 999;
468 }
469 return rc;
470 }
471 #endif /* SQLITE_OMIT_AUTHORIZATION */
472
473 /*
474 ** The "sqlite" command below creates a new Tcl command for each
475 ** connection it opens to an SQLite database. This routine is invoked
476 ** whenever one of those connection-specific commands is executed
477 ** in Tcl. For example, if you run Tcl code like this:
478 **
479 ** sqlite db1 "my_database"
480 ** db1 close
481 **
482 ** The first command opens a connection to the "my_database" database
483 ** and calls that connection "db1". The second command causes this
484 ** subroutine to be invoked.
485 */
DbObjCmd(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)486 static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
487 SqliteDb *pDb = (SqliteDb*)cd;
488 int choice;
489 int rc = TCL_OK;
490 static const char *DB_strs[] = {
491 "authorizer", "busy", "changes",
492 "close", "commit_hook", "complete",
493 "errorcode", "eval", "function",
494 "last_insert_rowid", "last_statement_changes", "onecolumn",
495 "progress", "rekey", "timeout",
496 "trace",
497 0
498 };
499 enum DB_enum {
500 DB_AUTHORIZER, DB_BUSY, DB_CHANGES,
501 DB_CLOSE, DB_COMMIT_HOOK, DB_COMPLETE,
502 DB_ERRORCODE, DB_EVAL, DB_FUNCTION,
503 DB_LAST_INSERT_ROWID, DB_LAST_STATEMENT_CHANGES, DB_ONECOLUMN,
504 DB_PROGRESS, DB_REKEY, DB_TIMEOUT,
505 DB_TRACE
506 };
507
508 if( objc<2 ){
509 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
510 return TCL_ERROR;
511 }
512 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
513 return TCL_ERROR;
514 }
515
516 switch( (enum DB_enum)choice ){
517
518 /* $db authorizer ?CALLBACK?
519 **
520 ** Invoke the given callback to authorize each SQL operation as it is
521 ** compiled. 5 arguments are appended to the callback before it is
522 ** invoked:
523 **
524 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
525 ** (2) First descriptive name (depends on authorization type)
526 ** (3) Second descriptive name
527 ** (4) Name of the database (ex: "main", "temp")
528 ** (5) Name of trigger that is doing the access
529 **
530 ** The callback should return on of the following strings: SQLITE_OK,
531 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
532 **
533 ** If this method is invoked with no arguments, the current authorization
534 ** callback string is returned.
535 */
536 case DB_AUTHORIZER: {
537 if( objc>3 ){
538 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
539 }else if( objc==2 ){
540 if( pDb->zAuth ){
541 Tcl_AppendResult(interp, pDb->zAuth, 0);
542 }
543 }else{
544 char *zAuth;
545 int len;
546 if( pDb->zAuth ){
547 Tcl_Free(pDb->zAuth);
548 }
549 zAuth = Tcl_GetStringFromObj(objv[2], &len);
550 if( zAuth && len>0 ){
551 pDb->zAuth = Tcl_Alloc( len + 1 );
552 strcpy(pDb->zAuth, zAuth);
553 }else{
554 pDb->zAuth = 0;
555 }
556 #ifndef SQLITE_OMIT_AUTHORIZATION
557 if( pDb->zAuth ){
558 pDb->interp = interp;
559 sqlite_set_authorizer(pDb->db, auth_callback, pDb);
560 }else{
561 sqlite_set_authorizer(pDb->db, 0, 0);
562 }
563 #endif
564 }
565 break;
566 }
567
568 /* $db busy ?CALLBACK?
569 **
570 ** Invoke the given callback if an SQL statement attempts to open
571 ** a locked database file.
572 */
573 case DB_BUSY: {
574 if( objc>3 ){
575 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
576 return TCL_ERROR;
577 }else if( objc==2 ){
578 if( pDb->zBusy ){
579 Tcl_AppendResult(interp, pDb->zBusy, 0);
580 }
581 }else{
582 char *zBusy;
583 int len;
584 if( pDb->zBusy ){
585 Tcl_Free(pDb->zBusy);
586 }
587 zBusy = Tcl_GetStringFromObj(objv[2], &len);
588 if( zBusy && len>0 ){
589 pDb->zBusy = Tcl_Alloc( len + 1 );
590 strcpy(pDb->zBusy, zBusy);
591 }else{
592 pDb->zBusy = 0;
593 }
594 if( pDb->zBusy ){
595 pDb->interp = interp;
596 sqlite_busy_handler(pDb->db, DbBusyHandler, pDb);
597 }else{
598 sqlite_busy_handler(pDb->db, 0, 0);
599 }
600 }
601 break;
602 }
603
604 /* $db progress ?N CALLBACK?
605 **
606 ** Invoke the given callback every N virtual machine opcodes while executing
607 ** queries.
608 */
609 case DB_PROGRESS: {
610 if( objc==2 ){
611 if( pDb->zProgress ){
612 Tcl_AppendResult(interp, pDb->zProgress, 0);
613 }
614 }else if( objc==4 ){
615 char *zProgress;
616 int len;
617 int N;
618 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
619 return TCL_ERROR;
620 };
621 if( pDb->zProgress ){
622 Tcl_Free(pDb->zProgress);
623 }
624 zProgress = Tcl_GetStringFromObj(objv[3], &len);
625 if( zProgress && len>0 ){
626 pDb->zProgress = Tcl_Alloc( len + 1 );
627 strcpy(pDb->zProgress, zProgress);
628 }else{
629 pDb->zProgress = 0;
630 }
631 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
632 if( pDb->zProgress ){
633 pDb->interp = interp;
634 sqlite_progress_handler(pDb->db, N, DbProgressHandler, pDb);
635 }else{
636 sqlite_progress_handler(pDb->db, 0, 0, 0);
637 }
638 #endif
639 }else{
640 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
641 return TCL_ERROR;
642 }
643 break;
644 }
645
646 /*
647 ** $db changes
648 **
649 ** Return the number of rows that were modified, inserted, or deleted by
650 ** the most recent "eval".
651 */
652 case DB_CHANGES: {
653 Tcl_Obj *pResult;
654 int nChange;
655 if( objc!=2 ){
656 Tcl_WrongNumArgs(interp, 2, objv, "");
657 return TCL_ERROR;
658 }
659 nChange = sqlite_changes(pDb->db);
660 pResult = Tcl_GetObjResult(interp);
661 Tcl_SetIntObj(pResult, nChange);
662 break;
663 }
664
665 /*
666 ** $db last_statement_changes
667 **
668 ** Return the number of rows that were modified, inserted, or deleted by
669 ** the last statment to complete execution (excluding changes due to
670 ** triggers)
671 */
672 case DB_LAST_STATEMENT_CHANGES: {
673 Tcl_Obj *pResult;
674 int lsChange;
675 if( objc!=2 ){
676 Tcl_WrongNumArgs(interp, 2, objv, "");
677 return TCL_ERROR;
678 }
679 lsChange = sqlite_last_statement_changes(pDb->db);
680 pResult = Tcl_GetObjResult(interp);
681 Tcl_SetIntObj(pResult, lsChange);
682 break;
683 }
684
685 /* $db close
686 **
687 ** Shutdown the database
688 */
689 case DB_CLOSE: {
690 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
691 break;
692 }
693
694 /* $db commit_hook ?CALLBACK?
695 **
696 ** Invoke the given callback just before committing every SQL transaction.
697 ** If the callback throws an exception or returns non-zero, then the
698 ** transaction is aborted. If CALLBACK is an empty string, the callback
699 ** is disabled.
700 */
701 case DB_COMMIT_HOOK: {
702 if( objc>3 ){
703 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
704 }else if( objc==2 ){
705 if( pDb->zCommit ){
706 Tcl_AppendResult(interp, pDb->zCommit, 0);
707 }
708 }else{
709 char *zCommit;
710 int len;
711 if( pDb->zCommit ){
712 Tcl_Free(pDb->zCommit);
713 }
714 zCommit = Tcl_GetStringFromObj(objv[2], &len);
715 if( zCommit && len>0 ){
716 pDb->zCommit = Tcl_Alloc( len + 1 );
717 strcpy(pDb->zCommit, zCommit);
718 }else{
719 pDb->zCommit = 0;
720 }
721 if( pDb->zCommit ){
722 pDb->interp = interp;
723 sqlite_commit_hook(pDb->db, DbCommitHandler, pDb);
724 }else{
725 sqlite_commit_hook(pDb->db, 0, 0);
726 }
727 }
728 break;
729 }
730
731 /* $db complete SQL
732 **
733 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if
734 ** additional lines of input are needed. This is similar to the
735 ** built-in "info complete" command of Tcl.
736 */
737 case DB_COMPLETE: {
738 Tcl_Obj *pResult;
739 int isComplete;
740 if( objc!=3 ){
741 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
742 return TCL_ERROR;
743 }
744 isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) );
745 pResult = Tcl_GetObjResult(interp);
746 Tcl_SetBooleanObj(pResult, isComplete);
747 break;
748 }
749
750 /*
751 ** $db errorcode
752 **
753 ** Return the numeric error code that was returned by the most recent
754 ** call to sqlite_exec().
755 */
756 case DB_ERRORCODE: {
757 Tcl_SetObjResult(interp, Tcl_NewIntObj(pDb->rc));
758 break;
759 }
760
761 /*
762 ** $db eval $sql ?array { ...code... }?
763 **
764 ** The SQL statement in $sql is evaluated. For each row, the values are
765 ** placed in elements of the array named "array" and ...code... is executed.
766 ** If "array" and "code" are omitted, then no callback is every invoked.
767 ** If "array" is an empty string, then the values are placed in variables
768 ** that have the same name as the fields extracted by the query.
769 */
770 case DB_EVAL: {
771 CallbackData cbData;
772 char *zErrMsg;
773 char *zSql;
774 #ifdef UTF_TRANSLATION_NEEDED
775 Tcl_DString dSql;
776 int i;
777 #endif
778
779 if( objc!=5 && objc!=3 ){
780 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?");
781 return TCL_ERROR;
782 }
783 pDb->interp = interp;
784 zSql = Tcl_GetStringFromObj(objv[2], 0);
785 #ifdef UTF_TRANSLATION_NEEDED
786 Tcl_DStringInit(&dSql);
787 Tcl_UtfToExternalDString(NULL, zSql, -1, &dSql);
788 zSql = Tcl_DStringValue(&dSql);
789 #endif
790 Tcl_IncrRefCount(objv[2]);
791 if( objc==5 ){
792 cbData.interp = interp;
793 cbData.once = 1;
794 cbData.zArray = Tcl_GetStringFromObj(objv[3], 0);
795 cbData.pCode = objv[4];
796 cbData.tcl_rc = TCL_OK;
797 cbData.nColName = 0;
798 cbData.azColName = 0;
799 zErrMsg = 0;
800 Tcl_IncrRefCount(objv[3]);
801 Tcl_IncrRefCount(objv[4]);
802 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg);
803 Tcl_DecrRefCount(objv[4]);
804 Tcl_DecrRefCount(objv[3]);
805 if( cbData.tcl_rc==TCL_BREAK ){ cbData.tcl_rc = TCL_OK; }
806 }else{
807 Tcl_Obj *pList = Tcl_NewObj();
808 cbData.tcl_rc = TCL_OK;
809 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg);
810 Tcl_SetObjResult(interp, pList);
811 }
812 pDb->rc = rc;
813 if( rc==SQLITE_ABORT ){
814 if( zErrMsg ) free(zErrMsg);
815 rc = cbData.tcl_rc;
816 }else if( zErrMsg ){
817 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
818 free(zErrMsg);
819 rc = TCL_ERROR;
820 }else if( rc!=SQLITE_OK ){
821 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
822 rc = TCL_ERROR;
823 }else{
824 }
825 Tcl_DecrRefCount(objv[2]);
826 #ifdef UTF_TRANSLATION_NEEDED
827 Tcl_DStringFree(&dSql);
828 if( objc==5 && cbData.azColName ){
829 for(i=0; i<cbData.nColName; i++){
830 if( cbData.azColName[i] ) free(cbData.azColName[i]);
831 }
832 free(cbData.azColName);
833 cbData.azColName = 0;
834 }
835 #endif
836 return rc;
837 }
838
839 /*
840 ** $db function NAME SCRIPT
841 **
842 ** Create a new SQL function called NAME. Whenever that function is
843 ** called, invoke SCRIPT to evaluate the function.
844 */
845 case DB_FUNCTION: {
846 SqlFunc *pFunc;
847 char *zName;
848 char *zScript;
849 int nScript;
850 if( objc!=4 ){
851 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
852 return TCL_ERROR;
853 }
854 zName = Tcl_GetStringFromObj(objv[2], 0);
855 zScript = Tcl_GetStringFromObj(objv[3], &nScript);
856 pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
857 if( pFunc==0 ) return TCL_ERROR;
858 pFunc->interp = interp;
859 pFunc->pNext = pDb->pFunc;
860 pFunc->zScript = (char*)&pFunc[1];
861 strcpy(pFunc->zScript, zScript);
862 sqlite_create_function(pDb->db, zName, -1, tclSqlFunc, pFunc);
863 sqlite_function_type(pDb->db, zName, SQLITE_NUMERIC);
864 break;
865 }
866
867 /*
868 ** $db last_insert_rowid
869 **
870 ** Return an integer which is the ROWID for the most recent insert.
871 */
872 case DB_LAST_INSERT_ROWID: {
873 Tcl_Obj *pResult;
874 int rowid;
875 if( objc!=2 ){
876 Tcl_WrongNumArgs(interp, 2, objv, "");
877 return TCL_ERROR;
878 }
879 rowid = sqlite_last_insert_rowid(pDb->db);
880 pResult = Tcl_GetObjResult(interp);
881 Tcl_SetIntObj(pResult, rowid);
882 break;
883 }
884
885 /*
886 ** $db onecolumn SQL
887 **
888 ** Return a single column from a single row of the given SQL query.
889 */
890 case DB_ONECOLUMN: {
891 char *zSql;
892 char *zErrMsg = 0;
893 if( objc!=3 ){
894 Tcl_WrongNumArgs(interp, 2, objv, "SQL");
895 return TCL_ERROR;
896 }
897 zSql = Tcl_GetStringFromObj(objv[2], 0);
898 rc = sqlite_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
899 if( rc==SQLITE_ABORT ){
900 rc = SQLITE_OK;
901 }else if( zErrMsg ){
902 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
903 free(zErrMsg);
904 rc = TCL_ERROR;
905 }else if( rc!=SQLITE_OK ){
906 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
907 rc = TCL_ERROR;
908 }
909 break;
910 }
911
912 /*
913 ** $db rekey KEY
914 **
915 ** Change the encryption key on the currently open database.
916 */
917 case DB_REKEY: {
918 int nKey;
919 void *pKey;
920 if( objc!=3 ){
921 Tcl_WrongNumArgs(interp, 2, objv, "KEY");
922 return TCL_ERROR;
923 }
924 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
925 #ifdef SQLITE_HAS_CODEC
926 rc = sqlite_rekey(pDb->db, pKey, nKey);
927 if( rc ){
928 Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
929 rc = TCL_ERROR;
930 }
931 #endif
932 break;
933 }
934
935 /*
936 ** $db timeout MILLESECONDS
937 **
938 ** Delay for the number of milliseconds specified when a file is locked.
939 */
940 case DB_TIMEOUT: {
941 int ms;
942 if( objc!=3 ){
943 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
944 return TCL_ERROR;
945 }
946 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
947 sqlite_busy_timeout(pDb->db, ms);
948 break;
949 }
950
951 /* $db trace ?CALLBACK?
952 **
953 ** Make arrangements to invoke the CALLBACK routine for each SQL statement
954 ** that is executed. The text of the SQL is appended to CALLBACK before
955 ** it is executed.
956 */
957 case DB_TRACE: {
958 if( objc>3 ){
959 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
960 }else if( objc==2 ){
961 if( pDb->zTrace ){
962 Tcl_AppendResult(interp, pDb->zTrace, 0);
963 }
964 }else{
965 char *zTrace;
966 int len;
967 if( pDb->zTrace ){
968 Tcl_Free(pDb->zTrace);
969 }
970 zTrace = Tcl_GetStringFromObj(objv[2], &len);
971 if( zTrace && len>0 ){
972 pDb->zTrace = Tcl_Alloc( len + 1 );
973 strcpy(pDb->zTrace, zTrace);
974 }else{
975 pDb->zTrace = 0;
976 }
977 if( pDb->zTrace ){
978 pDb->interp = interp;
979 sqlite_trace(pDb->db, DbTraceHandler, pDb);
980 }else{
981 sqlite_trace(pDb->db, 0, 0);
982 }
983 }
984 break;
985 }
986
987 } /* End of the SWITCH statement */
988 return rc;
989 }
990
991 /*
992 ** sqlite DBNAME FILENAME ?MODE? ?-key KEY?
993 **
994 ** This is the main Tcl command. When the "sqlite" Tcl command is
995 ** invoked, this routine runs to process that command.
996 **
997 ** The first argument, DBNAME, is an arbitrary name for a new
998 ** database connection. This command creates a new command named
999 ** DBNAME that is used to control that connection. The database
1000 ** connection is deleted when the DBNAME command is deleted.
1001 **
1002 ** The second argument is the name of the directory that contains
1003 ** the sqlite database that is to be accessed.
1004 **
1005 ** For testing purposes, we also support the following:
1006 **
1007 ** sqlite -encoding
1008 **
1009 ** Return the encoding used by LIKE and GLOB operators. Choices
1010 ** are UTF-8 and iso8859.
1011 **
1012 ** sqlite -version
1013 **
1014 ** Return the version number of the SQLite library.
1015 **
1016 ** sqlite -tcl-uses-utf
1017 **
1018 ** Return "1" if compiled with a Tcl uses UTF-8. Return "0" if
1019 ** not. Used by tests to make sure the library was compiled
1020 ** correctly.
1021 */
DbMain(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)1022 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
1023 int mode;
1024 SqliteDb *p;
1025 void *pKey = 0;
1026 int nKey = 0;
1027 const char *zArg;
1028 char *zErrMsg;
1029 const char *zFile;
1030 char zBuf[80];
1031 if( objc==2 ){
1032 zArg = Tcl_GetStringFromObj(objv[1], 0);
1033 if( strcmp(zArg,"-encoding")==0 ){
1034 Tcl_AppendResult(interp,sqlite_encoding,0);
1035 return TCL_OK;
1036 }
1037 if( strcmp(zArg,"-version")==0 ){
1038 Tcl_AppendResult(interp,sqlite_version,0);
1039 return TCL_OK;
1040 }
1041 if( strcmp(zArg,"-has-codec")==0 ){
1042 #ifdef SQLITE_HAS_CODEC
1043 Tcl_AppendResult(interp,"1",0);
1044 #else
1045 Tcl_AppendResult(interp,"0",0);
1046 #endif
1047 return TCL_OK;
1048 }
1049 if( strcmp(zArg,"-tcl-uses-utf")==0 ){
1050 #ifdef TCL_UTF_MAX
1051 Tcl_AppendResult(interp,"1",0);
1052 #else
1053 Tcl_AppendResult(interp,"0",0);
1054 #endif
1055 return TCL_OK;
1056 }
1057 }
1058 if( objc==5 || objc==6 ){
1059 zArg = Tcl_GetStringFromObj(objv[objc-2], 0);
1060 if( strcmp(zArg,"-key")==0 ){
1061 pKey = Tcl_GetByteArrayFromObj(objv[objc-1], &nKey);
1062 objc -= 2;
1063 }
1064 }
1065 if( objc!=3 && objc!=4 ){
1066 Tcl_WrongNumArgs(interp, 1, objv,
1067 #ifdef SQLITE_HAS_CODEC
1068 "HANDLE FILENAME ?-key CODEC-KEY?"
1069 #else
1070 "HANDLE FILENAME ?MODE?"
1071 #endif
1072 );
1073 return TCL_ERROR;
1074 }
1075 if( objc==3 ){
1076 mode = 0666;
1077 }else if( Tcl_GetIntFromObj(interp, objv[3], &mode)!=TCL_OK ){
1078 return TCL_ERROR;
1079 }
1080 zErrMsg = 0;
1081 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
1082 if( p==0 ){
1083 Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
1084 return TCL_ERROR;
1085 }
1086 memset(p, 0, sizeof(*p));
1087 zFile = Tcl_GetStringFromObj(objv[2], 0);
1088 #ifdef SQLITE_HAS_CODEC
1089 p->db = sqlite_open_encrypted(zFile, pKey, nKey, 0, &zErrMsg);
1090 #else
1091 p->db = sqlite_open(zFile, mode, &zErrMsg);
1092 #endif
1093 if( p->db==0 ){
1094 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
1095 Tcl_Free((char*)p);
1096 free(zErrMsg);
1097 return TCL_ERROR;
1098 }
1099 zArg = Tcl_GetStringFromObj(objv[1], 0);
1100 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
1101
1102 /* The return value is the value of the sqlite* pointer
1103 */
1104 sprintf(zBuf, "%p", p->db);
1105 if( strncmp(zBuf,"0x",2) ){
1106 sprintf(zBuf, "0x%p", p->db);
1107 }
1108 Tcl_AppendResult(interp, zBuf, 0);
1109
1110 /* If compiled with SQLITE_TEST turned on, then register the "md5sum"
1111 ** SQL function.
1112 */
1113 #ifdef SQLITE_TEST
1114 {
1115 extern void Md5_Register(sqlite*);
1116 Md5_Register(p->db);
1117 }
1118 #endif
1119 return TCL_OK;
1120 }
1121
1122 /*
1123 ** Provide a dummy Tcl_InitStubs if we are using this as a static
1124 ** library.
1125 */
1126 #ifndef USE_TCL_STUBS
1127 # undef Tcl_InitStubs
1128 # define Tcl_InitStubs(a,b,c)
1129 #endif
1130
1131 /*
1132 ** Initialize this module.
1133 **
1134 ** This Tcl module contains only a single new Tcl command named "sqlite".
1135 ** (Hence there is no namespace. There is no point in using a namespace
1136 ** if the extension only supplies one new name!) The "sqlite" command is
1137 ** used to open a new SQLite database. See the DbMain() routine above
1138 ** for additional information.
1139 */
Sqlite_Init(Tcl_Interp * interp)1140 int Sqlite_Init(Tcl_Interp *interp){
1141 Tcl_InitStubs(interp, "8.0", 0);
1142 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
1143 Tcl_PkgProvide(interp, "sqlite", "2.0");
1144 return TCL_OK;
1145 }
Tclsqlite_Init(Tcl_Interp * interp)1146 int Tclsqlite_Init(Tcl_Interp *interp){
1147 Tcl_InitStubs(interp, "8.0", 0);
1148 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
1149 Tcl_PkgProvide(interp, "sqlite", "2.0");
1150 return TCL_OK;
1151 }
Sqlite_SafeInit(Tcl_Interp * interp)1152 int Sqlite_SafeInit(Tcl_Interp *interp){
1153 return TCL_OK;
1154 }
Tclsqlite_SafeInit(Tcl_Interp * interp)1155 int Tclsqlite_SafeInit(Tcl_Interp *interp){
1156 return TCL_OK;
1157 }
1158
1159 #if 0
1160 /*
1161 ** If compiled using mktclapp, this routine runs to initialize
1162 ** everything.
1163 */
1164 int Et_AppInit(Tcl_Interp *interp){
1165 return Sqlite_Init(interp);
1166 }
1167 #endif
1168 /***************************************************************************
1169 ** The remaining code is only included if the TCLSH macro is defined to
1170 ** be an integer greater than 0
1171 */
1172 #if defined(TCLSH) && TCLSH>0
1173
1174 /*
1175 ** If the macro TCLSH is defined and is one, then put in code for the
1176 ** "main" routine that implement a interactive shell into which the user
1177 ** can type TCL commands.
1178 */
1179 #if TCLSH==1
1180 static char zMainloop[] =
1181 "set line {}\n"
1182 "while {![eof stdin]} {\n"
1183 "if {$line!=\"\"} {\n"
1184 "puts -nonewline \"> \"\n"
1185 "} else {\n"
1186 "puts -nonewline \"% \"\n"
1187 "}\n"
1188 "flush stdout\n"
1189 "append line [gets stdin]\n"
1190 "if {[info complete $line]} {\n"
1191 "if {[catch {uplevel #0 $line} result]} {\n"
1192 "puts stderr \"Error: $result\"\n"
1193 "} elseif {$result!=\"\"} {\n"
1194 "puts $result\n"
1195 "}\n"
1196 "set line {}\n"
1197 "} else {\n"
1198 "append line \\n\n"
1199 "}\n"
1200 "}\n"
1201 ;
1202 #endif /* TCLSH==1 */
1203
Libsqlite_Init(Tcl_Interp * interp)1204 int Libsqlite_Init( Tcl_Interp *interp) {
1205 #ifdef TCL_THREADS
1206 if (Thread_Init(interp) == TCL_ERROR) {
1207 return TCL_ERROR;
1208 }
1209 #endif
1210 Sqlite_Init(interp);
1211 #ifdef SQLITE_TEST
1212 {
1213 extern int Sqlitetest1_Init(Tcl_Interp*);
1214 extern int Sqlitetest2_Init(Tcl_Interp*);
1215 extern int Sqlitetest3_Init(Tcl_Interp*);
1216 extern int Md5_Init(Tcl_Interp*);
1217 Sqlitetest1_Init(interp);
1218 Sqlitetest2_Init(interp);
1219 Sqlitetest3_Init(interp);
1220 Md5_Init(interp);
1221 Tcl_StaticPackage(interp, "sqlite", Libsqlite_Init, Libsqlite_Init);
1222 }
1223 #endif
1224 return TCL_OK;
1225 }
1226
1227 #define TCLSH_MAIN main /* Needed to fake out mktclapp */
1228 #if TCLSH==1
TCLSH_MAIN(int argc,char ** argv)1229 int TCLSH_MAIN(int argc, char **argv){
1230 #ifndef TCL_THREADS
1231 Tcl_Interp *interp;
1232 Tcl_FindExecutable(argv[0]);
1233 interp = Tcl_CreateInterp();
1234 Libsqlite_Init(interp);
1235 if( argc>=2 ){
1236 int i;
1237 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
1238 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
1239 for(i=2; i<argc; i++){
1240 Tcl_SetVar(interp, "argv", argv[i],
1241 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
1242 }
1243 if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
1244 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
1245 if( zInfo==0 ) zInfo = interp->result;
1246 fprintf(stderr,"%s: %s\n", *argv, zInfo);
1247 return TCL_ERROR;
1248 }
1249 }else{
1250 Tcl_GlobalEval(interp, zMainloop);
1251 }
1252 return 0;
1253 #else
1254 Tcl_Main(argc, argv, Libsqlite_Init);
1255 #endif /* TCL_THREADS */
1256 return 0;
1257 }
1258 #endif /* TCLSH==1 */
1259
1260
1261 /*
1262 ** If the macro TCLSH is set to 2, then implement a space analysis tool.
1263 */
1264 #if TCLSH==2
1265 static char zAnalysis[] =
1266 #include "spaceanal_tcl.h"
1267 ;
1268
main(int argc,char ** argv)1269 int main(int argc, char **argv){
1270 Tcl_Interp *interp;
1271 int i;
1272 Tcl_FindExecutable(argv[0]);
1273 interp = Tcl_CreateInterp();
1274 Libsqlite_Init(interp);
1275 Tcl_SetVar(interp,"argv0",argv[0],TCL_GLOBAL_ONLY);
1276 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
1277 for(i=1; i<argc; i++){
1278 Tcl_SetVar(interp, "argv", argv[i],
1279 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
1280 }
1281 if( Tcl_GlobalEval(interp, zAnalysis)!=TCL_OK ){
1282 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
1283 if( zInfo==0 ) zInfo = interp->result;
1284 fprintf(stderr,"%s: %s\n", *argv, zInfo);
1285 return TCL_ERROR;
1286 }
1287 return 0;
1288 }
1289 #endif /* TCLSH==2 */
1290
1291 #endif /* TCLSH */
1292
1293 #endif /* NO_TCL */
1294