source: trunk/src/3rdparty/sqlite/tclsqlite.c@ 205

Last change on this file since 205 was 205, checked in by rudi, 14 years ago

Added SQLite 2.8.17 sources. This allows to build at least one of the sql drivers / plugins.
File size: 36.7 KB
Line 
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*/
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/*
46** 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 */
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*/
66typedef struct CallbackData CallbackData;
67struct 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*/
85static 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*/
174static 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*/
224static 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*/
257static 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*/
285static 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*/
309static 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*/
333static 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*/
349static 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*/
367static 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*/
382static 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*/
407static 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*/
486static 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*/
1022static 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*/
1140int 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}
1146int 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}
1152int Sqlite_SafeInit(Tcl_Interp *interp){
1153 return TCL_OK;
1154}
1155int 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*/
1164int 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
1180static 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
1204int 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
1229int 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
1265static char zAnalysis[] =
1266#include "spaceanal_tcl.h"
1267;
1268
1269int 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 */
Note: See TracBrowser for help on using the repository browser.