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

Last change on this file 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.