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. Append this file to sqlite3.c and 13 ** compile the whole thing to build a TCL-enabled version of SQLite. 14 ** 15 ** $Id: tclsqlite.c,v 1.207 2007/11/14 06:48:48 danielk1977 Exp $ 16 */ 17 #include "tcl.h" 18 #include <errno.h> 19 20 /* 21 ** Some additional include files are needed if this file is not 22 ** appended to the amalgamation. 23 */ 24 #ifndef SQLITE_AMALGAMATION 25 # include "sqliteInt.h" 26 # include <stdlib.h> 27 # include <string.h> 28 # include <assert.h> 29 # include <ctype.h> 30 #endif 31 32 /* 33 * Windows needs to know which symbols to export. Unix does not. 34 * BUILD_sqlite should be undefined for Unix. 35 */ 36 #ifdef BUILD_sqlite 37 #undef TCL_STORAGE_CLASS 38 #define TCL_STORAGE_CLASS DLLEXPORT 39 #endif /* BUILD_sqlite */ 40 41 #define NUM_PREPARED_STMTS 10 42 #define MAX_PREPARED_STMTS 100 43 44 /* 45 ** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we 46 ** have to do a translation when going between the two. Set the 47 ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do 48 ** this translation. 49 */ 50 #if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8) 51 # define UTF_TRANSLATION_NEEDED 1 52 #endif 53 54 /* 55 ** New SQL functions can be created as TCL scripts. Each such function 56 ** is described by an instance of the following structure. 57 */ 58 typedef struct SqlFunc SqlFunc; 59 struct SqlFunc { 60 Tcl_Interp *interp; /* The TCL interpret to execute the function */ 61 Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */ 62 int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */ 63 char *zName; /* Name of this function */ 64 SqlFunc *pNext; /* Next function on the list of them all */ 65 }; 66 67 /* 68 ** New collation sequences function can be created as TCL scripts. Each such 69 ** function is described by an instance of the following structure. 70 */ 71 typedef struct SqlCollate SqlCollate; 72 struct SqlCollate { 73 Tcl_Interp *interp; /* The TCL interpret to execute the function */ 74 char *zScript; /* The script to be run */ 75 SqlCollate *pNext; /* Next function on the list of them all */ 76 }; 77 78 /* 79 ** Prepared statements are cached for faster execution. Each prepared 80 ** statement is described by an instance of the following structure. 81 */ 82 typedef struct SqlPreparedStmt SqlPreparedStmt; 83 struct SqlPreparedStmt { 84 SqlPreparedStmt *pNext; /* Next in linked list */ 85 SqlPreparedStmt *pPrev; /* Previous on the list */ 86 sqlite3_stmt *pStmt; /* The prepared statement */ 87 int nSql; /* chars in zSql[] */ 88 const char *zSql; /* Text of the SQL statement */ 89 }; 90 91 typedef struct IncrblobChannel IncrblobChannel; 92 93 /* 94 ** There is one instance of this structure for each SQLite database 95 ** that has been opened by the SQLite TCL interface. 96 */ 97 typedef struct SqliteDb SqliteDb; 98 struct SqliteDb { 99 sqlite3 *db; /* The "real" database structure. MUST BE FIRST */ 100 Tcl_Interp *interp; /* The interpreter used for this database */ 101 char *zBusy; /* The busy callback routine */ 102 char *zCommit; /* The commit hook callback routine */ 103 char *zTrace; /* The trace callback routine */ 104 char *zProfile; /* The profile callback routine */ 105 char *zProgress; /* The progress callback routine */ 106 char *zAuth; /* The authorization callback routine */ 107 char *zNull; /* Text to substitute for an SQL NULL value */ 108 SqlFunc *pFunc; /* List of SQL functions */ 109 Tcl_Obj *pUpdateHook; /* Update hook script (if any) */ 110 Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */ 111 SqlCollate *pCollate; /* List of SQL collation functions */ 112 int rc; /* Return code of most recent sqlite3_exec() */ 113 Tcl_Obj *pCollateNeeded; /* Collation needed script */ 114 SqlPreparedStmt *stmtList; /* List of prepared statements*/ 115 SqlPreparedStmt *stmtLast; /* Last statement in the list */ 116 int maxStmt; /* The next maximum number of stmtList */ 117 int nStmt; /* Number of statements in stmtList */ 118 IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */ 119 }; 120 121 struct IncrblobChannel { 122 sqlite3_blob *pBlob; /* sqlite3 blob handle */ 123 SqliteDb *pDb; /* Associated database connection */ 124 int iSeek; /* Current seek offset */ 125 Tcl_Channel channel; /* Channel identifier */ 126 IncrblobChannel *pNext; /* Linked list of all open incrblob channels */ 127 IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */ 128 }; 129 130 #ifndef SQLITE_OMIT_INCRBLOB 131 /* 132 ** Close all incrblob channels opened using database connection pDb. 133 ** This is called when shutting down the database connection. 134 */ 135 static void closeIncrblobChannels(SqliteDb *pDb){ 136 IncrblobChannel *p; 137 IncrblobChannel *pNext; 138 139 for(p=pDb->pIncrblob; p; p=pNext){ 140 pNext = p->pNext; 141 142 /* Note: Calling unregister here call Tcl_Close on the incrblob channel, 143 ** which deletes the IncrblobChannel structure at *p. So do not 144 ** call Tcl_Free() here. 145 */ 146 Tcl_UnregisterChannel(pDb->interp, p->channel); 147 } 148 } 149 150 /* 151 ** Close an incremental blob channel. 152 */ 153 static int incrblobClose(ClientData instanceData, Tcl_Interp *interp){ 154 IncrblobChannel *p = (IncrblobChannel *)instanceData; 155 int rc = sqlite3_blob_close(p->pBlob); 156 sqlite3 *db = p->pDb->db; 157 158 /* Remove the channel from the SqliteDb.pIncrblob list. */ 159 if( p->pNext ){ 160 p->pNext->pPrev = p->pPrev; 161 } 162 if( p->pPrev ){ 163 p->pPrev->pNext = p->pNext; 164 } 165 if( p->pDb->pIncrblob==p ){ 166 p->pDb->pIncrblob = p->pNext; 167 } 168 169 /* Free the IncrblobChannel structure */ 170 Tcl_Free((char *)p); 171 172 if( rc!=SQLITE_OK ){ 173 Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE); 174 return TCL_ERROR; 175 } 176 return TCL_OK; 177 } 178 179 /* 180 ** Read data from an incremental blob channel. 181 */ 182 static int incrblobInput( 183 ClientData instanceData, 184 char *buf, 185 int bufSize, 186 int *errorCodePtr 187 ){ 188 IncrblobChannel *p = (IncrblobChannel *)instanceData; 189 int nRead = bufSize; /* Number of bytes to read */ 190 int nBlob; /* Total size of the blob */ 191 int rc; /* sqlite error code */ 192 193 nBlob = sqlite3_blob_bytes(p->pBlob); 194 if( (p->iSeek+nRead)>nBlob ){ 195 nRead = nBlob-p->iSeek; 196 } 197 if( nRead<=0 ){ 198 return 0; 199 } 200 201 rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek); 202 if( rc!=SQLITE_OK ){ 203 *errorCodePtr = rc; 204 return -1; 205 } 206 207 p->iSeek += nRead; 208 return nRead; 209 } 210 211 /* 212 ** Write data to an incremental blob channel. 213 */ 214 static int incrblobOutput( 215 ClientData instanceData, 216 CONST char *buf, 217 int toWrite, 218 int *errorCodePtr 219 ){ 220 IncrblobChannel *p = (IncrblobChannel *)instanceData; 221 int nWrite = toWrite; /* Number of bytes to write */ 222 int nBlob; /* Total size of the blob */ 223 int rc; /* sqlite error code */ 224 225 nBlob = sqlite3_blob_bytes(p->pBlob); 226 if( (p->iSeek+nWrite)>nBlob ){ 227 *errorCodePtr = EINVAL; 228 return -1; 229 } 230 if( nWrite<=0 ){ 231 return 0; 232 } 233 234 rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek); 235 if( rc!=SQLITE_OK ){ 236 *errorCodePtr = EIO; 237 return -1; 238 } 239 240 p->iSeek += nWrite; 241 return nWrite; 242 } 243 244 /* 245 ** Seek an incremental blob channel. 246 */ 247 static int incrblobSeek( 248 ClientData instanceData, 249 long offset, 250 int seekMode, 251 int *errorCodePtr 252 ){ 253 IncrblobChannel *p = (IncrblobChannel *)instanceData; 254 255 switch( seekMode ){ 256 case SEEK_SET: 257 p->iSeek = offset; 258 break; 259 case SEEK_CUR: 260 p->iSeek += offset; 261 break; 262 case SEEK_END: 263 p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset; 264 break; 265 266 default: assert(!"Bad seekMode"); 267 } 268 269 return p->iSeek; 270 } 271 272 273 static void incrblobWatch(ClientData instanceData, int mode){ 274 /* NO-OP */ 275 } 276 static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){ 277 return TCL_ERROR; 278 } 279 280 static Tcl_ChannelType IncrblobChannelType = { 281 "incrblob", /* typeName */ 282 TCL_CHANNEL_VERSION_2, /* version */ 283 incrblobClose, /* closeProc */ 284 incrblobInput, /* inputProc */ 285 incrblobOutput, /* outputProc */ 286 incrblobSeek, /* seekProc */ 287 0, /* setOptionProc */ 288 0, /* getOptionProc */ 289 incrblobWatch, /* watchProc (this is a no-op) */ 290 incrblobHandle, /* getHandleProc (always returns error) */ 291 0, /* close2Proc */ 292 0, /* blockModeProc */ 293 0, /* flushProc */ 294 0, /* handlerProc */ 295 0, /* wideSeekProc */ 296 }; 297 298 /* 299 ** Create a new incrblob channel. 300 */ 301 static int createIncrblobChannel( 302 Tcl_Interp *interp, 303 SqliteDb *pDb, 304 const char *zDb, 305 const char *zTable, 306 const char *zColumn, 307 sqlite_int64 iRow, 308 int isReadonly 309 ){ 310 IncrblobChannel *p; 311 sqlite3 *db = pDb->db; 312 sqlite3_blob *pBlob; 313 int rc; 314 int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE); 315 316 /* This variable is used to name the channels: "incrblob_[incr count]" */ 317 static int count = 0; 318 char zChannel[64]; 319 320 rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob); 321 if( rc!=SQLITE_OK ){ 322 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 323 return TCL_ERROR; 324 } 325 326 p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel)); 327 p->iSeek = 0; 328 p->pBlob = pBlob; 329 330 sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count); 331 p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags); 332 Tcl_RegisterChannel(interp, p->channel); 333 334 /* Link the new channel into the SqliteDb.pIncrblob list. */ 335 p->pNext = pDb->pIncrblob; 336 p->pPrev = 0; 337 if( p->pNext ){ 338 p->pNext->pPrev = p; 339 } 340 pDb->pIncrblob = p; 341 p->pDb = pDb; 342 343 Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE); 344 return TCL_OK; 345 } 346 #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */ 347 #define closeIncrblobChannels(pDb) 348 #endif 349 350 /* 351 ** Look at the script prefix in pCmd. We will be executing this script 352 ** after first appending one or more arguments. This routine analyzes 353 ** the script to see if it is safe to use Tcl_EvalObjv() on the script 354 ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much 355 ** faster. 356 ** 357 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a 358 ** command name followed by zero or more arguments with no [...] or $ 359 ** or {...} or ; to be seen anywhere. Most callback scripts consist 360 ** of just a single procedure name and they meet this requirement. 361 */ 362 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){ 363 /* We could try to do something with Tcl_Parse(). But we will instead 364 ** just do a search for forbidden characters. If any of the forbidden 365 ** characters appear in pCmd, we will report the string as unsafe. 366 */ 367 const char *z; 368 int n; 369 z = Tcl_GetStringFromObj(pCmd, &n); 370 while( n-- > 0 ){ 371 int c = *(z++); 372 if( c=='$' || c=='[' || c==';' ) return 0; 373 } 374 return 1; 375 } 376 377 /* 378 ** Find an SqlFunc structure with the given name. Or create a new 379 ** one if an existing one cannot be found. Return a pointer to the 380 ** structure. 381 */ 382 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ 383 SqlFunc *p, *pNew; 384 int i; 385 pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 ); 386 pNew->zName = (char*)&pNew[1]; 387 for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); } 388 pNew->zName[i] = 0; 389 for(p=pDb->pFunc; p; p=p->pNext){ 390 if( strcmp(p->zName, pNew->zName)==0 ){ 391 Tcl_Free((char*)pNew); 392 return p; 393 } 394 } 395 pNew->interp = pDb->interp; 396 pNew->pScript = 0; 397 pNew->pNext = pDb->pFunc; 398 pDb->pFunc = pNew; 399 return pNew; 400 } 401 402 /* 403 ** Finalize and free a list of prepared statements 404 */ 405 static void flushStmtCache( SqliteDb *pDb ){ 406 SqlPreparedStmt *pPreStmt; 407 408 while( pDb->stmtList ){ 409 sqlite3_finalize( pDb->stmtList->pStmt ); 410 pPreStmt = pDb->stmtList; 411 pDb->stmtList = pDb->stmtList->pNext; 412 Tcl_Free( (char*)pPreStmt ); 413 } 414 pDb->nStmt = 0; 415 pDb->stmtLast = 0; 416 } 417 418 /* 419 ** TCL calls this procedure when an sqlite3 database command is 420 ** deleted. 421 */ 422 static void DbDeleteCmd(void *db){ 423 SqliteDb *pDb = (SqliteDb*)db; 424 flushStmtCache(pDb); 425 closeIncrblobChannels(pDb); 426 sqlite3_close(pDb->db); 427 while( pDb->pFunc ){ 428 SqlFunc *pFunc = pDb->pFunc; 429 pDb->pFunc = pFunc->pNext; 430 Tcl_DecrRefCount(pFunc->pScript); 431 Tcl_Free((char*)pFunc); 432 } 433 while( pDb->pCollate ){ 434 SqlCollate *pCollate = pDb->pCollate; 435 pDb->pCollate = pCollate->pNext; 436 Tcl_Free((char*)pCollate); 437 } 438 if( pDb->zBusy ){ 439 Tcl_Free(pDb->zBusy); 440 } 441 if( pDb->zTrace ){ 442 Tcl_Free(pDb->zTrace); 443 } 444 if( pDb->zProfile ){ 445 Tcl_Free(pDb->zProfile); 446 } 447 if( pDb->zAuth ){ 448 Tcl_Free(pDb->zAuth); 449 } 450 if( pDb->zNull ){ 451 Tcl_Free(pDb->zNull); 452 } 453 if( pDb->pUpdateHook ){ 454 Tcl_DecrRefCount(pDb->pUpdateHook); 455 } 456 if( pDb->pRollbackHook ){ 457 Tcl_DecrRefCount(pDb->pRollbackHook); 458 } 459 if( pDb->pCollateNeeded ){ 460 Tcl_DecrRefCount(pDb->pCollateNeeded); 461 } 462 Tcl_Free((char*)pDb); 463 } 464 465 /* 466 ** This routine is called when a database file is locked while trying 467 ** to execute SQL. 468 */ 469 static int DbBusyHandler(void *cd, int nTries){ 470 SqliteDb *pDb = (SqliteDb*)cd; 471 int rc; 472 char zVal[30]; 473 474 sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries); 475 rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0); 476 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 477 return 0; 478 } 479 return 1; 480 } 481 482 /* 483 ** This routine is invoked as the 'progress callback' for the database. 484 */ 485 static int DbProgressHandler(void *cd){ 486 SqliteDb *pDb = (SqliteDb*)cd; 487 int rc; 488 489 assert( pDb->zProgress ); 490 rc = Tcl_Eval(pDb->interp, pDb->zProgress); 491 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 492 return 1; 493 } 494 return 0; 495 } 496 497 #ifndef SQLITE_OMIT_TRACE 498 /* 499 ** This routine is called by the SQLite trace handler whenever a new 500 ** block of SQL is executed. The TCL script in pDb->zTrace is executed. 501 */ 502 static void DbTraceHandler(void *cd, const char *zSql){ 503 SqliteDb *pDb = (SqliteDb*)cd; 504 Tcl_DString str; 505 506 Tcl_DStringInit(&str); 507 Tcl_DStringAppend(&str, pDb->zTrace, -1); 508 Tcl_DStringAppendElement(&str, zSql); 509 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str)); 510 Tcl_DStringFree(&str); 511 Tcl_ResetResult(pDb->interp); 512 } 513 #endif 514 515 #ifndef SQLITE_OMIT_TRACE 516 /* 517 ** This routine is called by the SQLite profile handler after a statement 518 ** SQL has executed. The TCL script in pDb->zProfile is evaluated. 519 */ 520 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){ 521 SqliteDb *pDb = (SqliteDb*)cd; 522 Tcl_DString str; 523 char zTm[100]; 524 525 sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm); 526 Tcl_DStringInit(&str); 527 Tcl_DStringAppend(&str, pDb->zProfile, -1); 528 Tcl_DStringAppendElement(&str, zSql); 529 Tcl_DStringAppendElement(&str, zTm); 530 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str)); 531 Tcl_DStringFree(&str); 532 Tcl_ResetResult(pDb->interp); 533 } 534 #endif 535 536 /* 537 ** This routine is called when a transaction is committed. The 538 ** TCL script in pDb->zCommit is executed. If it returns non-zero or 539 ** if it throws an exception, the transaction is rolled back instead 540 ** of being committed. 541 */ 542 static int DbCommitHandler(void *cd){ 543 SqliteDb *pDb = (SqliteDb*)cd; 544 int rc; 545 546 rc = Tcl_Eval(pDb->interp, pDb->zCommit); 547 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 548 return 1; 549 } 550 return 0; 551 } 552 553 static void DbRollbackHandler(void *clientData){ 554 SqliteDb *pDb = (SqliteDb*)clientData; 555 assert(pDb->pRollbackHook); 556 if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){ 557 Tcl_BackgroundError(pDb->interp); 558 } 559 } 560 561 static void DbUpdateHandler( 562 void *p, 563 int op, 564 const char *zDb, 565 const char *zTbl, 566 sqlite_int64 rowid 567 ){ 568 SqliteDb *pDb = (SqliteDb *)p; 569 Tcl_Obj *pCmd; 570 571 assert( pDb->pUpdateHook ); 572 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE ); 573 574 pCmd = Tcl_DuplicateObj(pDb->pUpdateHook); 575 Tcl_IncrRefCount(pCmd); 576 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj( 577 ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1)); 578 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1)); 579 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1)); 580 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid)); 581 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT); 582 } 583 584 static void tclCollateNeeded( 585 void *pCtx, 586 sqlite3 *db, 587 int enc, 588 const char *zName 589 ){ 590 SqliteDb *pDb = (SqliteDb *)pCtx; 591 Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded); 592 Tcl_IncrRefCount(pScript); 593 Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1)); 594 Tcl_EvalObjEx(pDb->interp, pScript, 0); 595 Tcl_DecrRefCount(pScript); 596 } 597 598 /* 599 ** This routine is called to evaluate an SQL collation function implemented 600 ** using TCL script. 601 */ 602 static int tclSqlCollate( 603 void *pCtx, 604 int nA, 605 const void *zA, 606 int nB, 607 const void *zB 608 ){ 609 SqlCollate *p = (SqlCollate *)pCtx; 610 Tcl_Obj *pCmd; 611 612 pCmd = Tcl_NewStringObj(p->zScript, -1); 613 Tcl_IncrRefCount(pCmd); 614 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA)); 615 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB)); 616 Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); 617 Tcl_DecrRefCount(pCmd); 618 return (atoi(Tcl_GetStringResult(p->interp))); 619 } 620 621 /* 622 ** This routine is called to evaluate an SQL function implemented 623 ** using TCL script. 624 */ 625 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ 626 SqlFunc *p = sqlite3_user_data(context); 627 Tcl_Obj *pCmd; 628 int i; 629 int rc; 630 631 if( argc==0 ){ 632 /* If there are no arguments to the function, call Tcl_EvalObjEx on the 633 ** script object directly. This allows the TCL compiler to generate 634 ** bytecode for the command on the first invocation and thus make 635 ** subsequent invocations much faster. */ 636 pCmd = p->pScript; 637 Tcl_IncrRefCount(pCmd); 638 rc = Tcl_EvalObjEx(p->interp, pCmd, 0); 639 Tcl_DecrRefCount(pCmd); 640 }else{ 641 /* If there are arguments to the function, make a shallow copy of the 642 ** script object, lappend the arguments, then evaluate the copy. 643 ** 644 ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated. 645 ** The new Tcl_Obj contains pointers to the original list elements. 646 ** That way, when Tcl_EvalObjv() is run and shimmers the first element 647 ** of the list to tclCmdNameType, that alternate representation will 648 ** be preserved and reused on the next invocation. 649 */ 650 Tcl_Obj **aArg; 651 int nArg; 652 if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){ 653 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 654 return; 655 } 656 pCmd = Tcl_NewListObj(nArg, aArg); 657 Tcl_IncrRefCount(pCmd); 658 for(i=0; i<argc; i++){ 659 sqlite3_value *pIn = argv[i]; 660 Tcl_Obj *pVal; 661 662 /* Set pVal to contain the i'th column of this row. */ 663 switch( sqlite3_value_type(pIn) ){ 664 case SQLITE_BLOB: { 665 int bytes = sqlite3_value_bytes(pIn); 666 pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes); 667 break; 668 } 669 case SQLITE_INTEGER: { 670 sqlite_int64 v = sqlite3_value_int64(pIn); 671 if( v>=-2147483647 && v<=2147483647 ){ 672 pVal = Tcl_NewIntObj(v); 673 }else{ 674 pVal = Tcl_NewWideIntObj(v); 675 } 676 break; 677 } 678 case SQLITE_FLOAT: { 679 double r = sqlite3_value_double(pIn); 680 pVal = Tcl_NewDoubleObj(r); 681 break; 682 } 683 case SQLITE_NULL: { 684 pVal = Tcl_NewStringObj("", 0); 685 break; 686 } 687 default: { 688 int bytes = sqlite3_value_bytes(pIn); 689 pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes); 690 break; 691 } 692 } 693 rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal); 694 if( rc ){ 695 Tcl_DecrRefCount(pCmd); 696 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 697 return; 698 } 699 } 700 if( !p->useEvalObjv ){ 701 /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd 702 ** is a list without a string representation. To prevent this from 703 ** happening, make sure pCmd has a valid string representation */ 704 Tcl_GetString(pCmd); 705 } 706 rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); 707 Tcl_DecrRefCount(pCmd); 708 } 709 710 if( rc && rc!=TCL_RETURN ){ 711 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 712 }else{ 713 Tcl_Obj *pVar = Tcl_GetObjResult(p->interp); 714 int n; 715 u8 *data; 716 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 717 char c = zType[0]; 718 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ 719 /* Only return a BLOB type if the Tcl variable is a bytearray and 720 ** has no string representation. */ 721 data = Tcl_GetByteArrayFromObj(pVar, &n); 722 sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); 723 }else if( c=='b' && strcmp(zType,"boolean")==0 ){ 724 Tcl_GetIntFromObj(0, pVar, &n); 725 sqlite3_result_int(context, n); 726 }else if( c=='d' && strcmp(zType,"double")==0 ){ 727 double r; 728 Tcl_GetDoubleFromObj(0, pVar, &r); 729 sqlite3_result_double(context, r); 730 }else if( (c=='w' && strcmp(zType,"wideInt")==0) || 731 (c=='i' && strcmp(zType,"int")==0) ){ 732 Tcl_WideInt v; 733 Tcl_GetWideIntFromObj(0, pVar, &v); 734 sqlite3_result_int64(context, v); 735 }else{ 736 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 737 sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); 738 } 739 } 740 } 741 742 #ifndef SQLITE_OMIT_AUTHORIZATION 743 /* 744 ** This is the authentication function. It appends the authentication 745 ** type code and the two arguments to zCmd[] then invokes the result 746 ** on the interpreter. The reply is examined to determine if the 747 ** authentication fails or succeeds. 748 */ 749 static int auth_callback( 750 void *pArg, 751 int code, 752 const char *zArg1, 753 const char *zArg2, 754 const char *zArg3, 755 const char *zArg4 756 ){ 757 char *zCode; 758 Tcl_DString str; 759 int rc; 760 const char *zReply; 761 SqliteDb *pDb = (SqliteDb*)pArg; 762 763 switch( code ){ 764 case SQLITE_COPY : zCode="SQLITE_COPY"; break; 765 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break; 766 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break; 767 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break; 768 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break; 769 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break; 770 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break; 771 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break; 772 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break; 773 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break; 774 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break; 775 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break; 776 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break; 777 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break; 778 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break; 779 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break; 780 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break; 781 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break; 782 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break; 783 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break; 784 case SQLITE_READ : zCode="SQLITE_READ"; break; 785 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break; 786 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break; 787 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break; 788 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break; 789 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break; 790 case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break; 791 case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break; 792 case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break; 793 case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break; 794 case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break; 795 case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break; 796 default : zCode="????"; break; 797 } 798 Tcl_DStringInit(&str); 799 Tcl_DStringAppend(&str, pDb->zAuth, -1); 800 Tcl_DStringAppendElement(&str, zCode); 801 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : ""); 802 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : ""); 803 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : ""); 804 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : ""); 805 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str)); 806 Tcl_DStringFree(&str); 807 zReply = Tcl_GetStringResult(pDb->interp); 808 if( strcmp(zReply,"SQLITE_OK")==0 ){ 809 rc = SQLITE_OK; 810 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){ 811 rc = SQLITE_DENY; 812 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){ 813 rc = SQLITE_IGNORE; 814 }else{ 815 rc = 999; 816 } 817 return rc; 818 } 819 #endif /* SQLITE_OMIT_AUTHORIZATION */ 820 821 /* 822 ** zText is a pointer to text obtained via an sqlite3_result_text() 823 ** or similar interface. This routine returns a Tcl string object, 824 ** reference count set to 0, containing the text. If a translation 825 ** between iso8859 and UTF-8 is required, it is preformed. 826 */ 827 static Tcl_Obj *dbTextToObj(char const *zText){ 828 Tcl_Obj *pVal; 829 #ifdef UTF_TRANSLATION_NEEDED 830 Tcl_DString dCol; 831 Tcl_DStringInit(&dCol); 832 Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol); 833 pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1); 834 Tcl_DStringFree(&dCol); 835 #else 836 pVal = Tcl_NewStringObj(zText, -1); 837 #endif 838 return pVal; 839 } 840 841 /* 842 ** This routine reads a line of text from FILE in, stores 843 ** the text in memory obtained from malloc() and returns a pointer 844 ** to the text. NULL is returned at end of file, or if malloc() 845 ** fails. 846 ** 847 ** The interface is like "readline" but no command-line editing 848 ** is done. 849 ** 850 ** copied from shell.c from '.import' command 851 */ 852 static char *local_getline(char *zPrompt, FILE *in){ 853 char *zLine; 854 int nLine; 855 int n; 856 int eol; 857 858 nLine = 100; 859 zLine = malloc( nLine ); 860 if( zLine==0 ) return 0; 861 n = 0; 862 eol = 0; 863 while( !eol ){ 864 if( n+100>nLine ){ 865 nLine = nLine*2 + 100; 866 zLine = realloc(zLine, nLine); 867 if( zLine==0 ) return 0; 868 } 869 if( fgets(&zLine[n], nLine - n, in)==0 ){ 870 if( n==0 ){ 871 free(zLine); 872 return 0; 873 } 874 zLine[n] = 0; 875 eol = 1; 876 break; 877 } 878 while( zLine[n] ){ n++; } 879 if( n>0 && zLine[n-1]=='\n' ){ 880 n--; 881 zLine[n] = 0; 882 eol = 1; 883 } 884 } 885 zLine = realloc( zLine, n+1 ); 886 return zLine; 887 } 888 889 890 /* 891 ** Figure out the column names for the data returned by the statement 892 ** passed as the second argument. 893 ** 894 ** If parameter papColName is not NULL, then *papColName is set to point 895 ** at an array allocated using Tcl_Alloc(). It is the callers responsibility 896 ** to free this array using Tcl_Free(), and to decrement the reference 897 ** count of each Tcl_Obj* member of the array. 898 ** 899 ** The return value of this function is the number of columns of data 900 ** returned by pStmt (and hence the size of the *papColName array). 901 ** 902 ** If pArray is not NULL, then it contains the name of a Tcl array 903 ** variable. The "*" member of this array is set to a list containing 904 ** the names of the columns returned by the statement, in order from 905 ** left to right. e.g. if the names of the returned columns are a, b and 906 ** c, it does the equivalent of the tcl command: 907 ** 908 ** set ${pArray}(*) {a b c} 909 */ 910 static int 911 computeColumnNames( 912 Tcl_Interp *interp, 913 sqlite3_stmt *pStmt, /* SQL statement */ 914 Tcl_Obj ***papColName, /* OUT: Array of column names */ 915 Tcl_Obj *pArray /* Name of array variable (may be null) */ 916 ){ 917 int nCol; 918 919 /* Compute column names */ 920 nCol = sqlite3_column_count(pStmt); 921 if( papColName ){ 922 int i; 923 Tcl_Obj **apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol ); 924 for(i=0; i<nCol; i++){ 925 apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i)); 926 Tcl_IncrRefCount(apColName[i]); 927 } 928 929 /* If results are being stored in an array variable, then create 930 ** the array(*) entry for that array 931 */ 932 if( pArray ){ 933 Tcl_Obj *pColList = Tcl_NewObj(); 934 Tcl_Obj *pStar = Tcl_NewStringObj("*", -1); 935 Tcl_IncrRefCount(pColList); 936 for(i=0; i<nCol; i++){ 937 Tcl_ListObjAppendElement(interp, pColList, apColName[i]); 938 } 939 Tcl_IncrRefCount(pStar); 940 Tcl_ObjSetVar2(interp, pArray, pStar, pColList,0); 941 Tcl_DecrRefCount(pColList); 942 Tcl_DecrRefCount(pStar); 943 } 944 *papColName = apColName; 945 } 946 947 return nCol; 948 } 949 950 /* 951 ** The "sqlite" command below creates a new Tcl command for each 952 ** connection it opens to an SQLite database. This routine is invoked 953 ** whenever one of those connection-specific commands is executed 954 ** in Tcl. For example, if you run Tcl code like this: 955 ** 956 ** sqlite3 db1 "my_database" 957 ** db1 close 958 ** 959 ** The first command opens a connection to the "my_database" database 960 ** and calls that connection "db1". The second command causes this 961 ** subroutine to be invoked. 962 */ 963 static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 964 SqliteDb *pDb = (SqliteDb*)cd; 965 int choice; 966 int rc = TCL_OK; 967 static const char *DB_strs[] = { 968 "authorizer", "busy", "cache", 969 "changes", "close", "collate", 970 "collation_needed", "commit_hook", "complete", 971 "copy", "enable_load_extension","errorcode", 972 "eval", "exists", "function", 973 "incrblob", "interrupt", "last_insert_rowid", 974 "nullvalue", "onecolumn", "profile", 975 "progress", "rekey", "rollback_hook", 976 "timeout", "total_changes", "trace", 977 "transaction", "update_hook", "version", 978 0 979 }; 980 enum DB_enum { 981 DB_AUTHORIZER, DB_BUSY, DB_CACHE, 982 DB_CHANGES, DB_CLOSE, DB_COLLATE, 983 DB_COLLATION_NEEDED, DB_COMMIT_HOOK, DB_COMPLETE, 984 DB_COPY, DB_ENABLE_LOAD_EXTENSION,DB_ERRORCODE, 985 DB_EVAL, DB_EXISTS, DB_FUNCTION, 986 DB_INCRBLOB, DB_INTERRUPT, DB_LAST_INSERT_ROWID, 987 DB_NULLVALUE, DB_ONECOLUMN, DB_PROFILE, 988 DB_PROGRESS, DB_REKEY, DB_ROLLBACK_HOOK, 989 DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE, 990 DB_TRANSACTION, DB_UPDATE_HOOK, DB_VERSION 991 }; 992 /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */ 993 994 if( objc<2 ){ 995 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ..."); 996 return TCL_ERROR; 997 } 998 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){ 999 return TCL_ERROR; 1000 } 1001 1002 switch( (enum DB_enum)choice ){ 1003 1004 /* $db authorizer ?CALLBACK? 1005 ** 1006 ** Invoke the given callback to authorize each SQL operation as it is 1007 ** compiled. 5 arguments are appended to the callback before it is 1008 ** invoked: 1009 ** 1010 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...) 1011 ** (2) First descriptive name (depends on authorization type) 1012 ** (3) Second descriptive name 1013 ** (4) Name of the database (ex: "main", "temp") 1014 ** (5) Name of trigger that is doing the access 1015 ** 1016 ** The callback should return on of the following strings: SQLITE_OK, 1017 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error. 1018 ** 1019 ** If this method is invoked with no arguments, the current authorization 1020 ** callback string is returned. 1021 */ 1022 case DB_AUTHORIZER: { 1023 #ifdef SQLITE_OMIT_AUTHORIZATION 1024 Tcl_AppendResult(interp, "authorization not available in this build", 0); 1025 return TCL_ERROR; 1026 #else 1027 if( objc>3 ){ 1028 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 1029 return TCL_ERROR; 1030 }else if( objc==2 ){ 1031 if( pDb->zAuth ){ 1032 Tcl_AppendResult(interp, pDb->zAuth, 0); 1033 } 1034 }else{ 1035 char *zAuth; 1036 int len; 1037 if( pDb->zAuth ){ 1038 Tcl_Free(pDb->zAuth); 1039 } 1040 zAuth = Tcl_GetStringFromObj(objv[2], &len); 1041 if( zAuth && len>0 ){ 1042 pDb->zAuth = Tcl_Alloc( len + 1 ); 1043 memcpy(pDb->zAuth, zAuth, len+1); 1044 }else{ 1045 pDb->zAuth = 0; 1046 } 1047 if( pDb->zAuth ){ 1048 pDb->interp = interp; 1049 sqlite3_set_authorizer(pDb->db, auth_callback, pDb); 1050 }else{ 1051 sqlite3_set_authorizer(pDb->db, 0, 0); 1052 } 1053 } 1054 #endif 1055 break; 1056 } 1057 1058 /* $db busy ?CALLBACK? 1059 ** 1060 ** Invoke the given callback if an SQL statement attempts to open 1061 ** a locked database file. 1062 */ 1063 case DB_BUSY: { 1064 if( objc>3 ){ 1065 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK"); 1066 return TCL_ERROR; 1067 }else if( objc==2 ){ 1068 if( pDb->zBusy ){ 1069 Tcl_AppendResult(interp, pDb->zBusy, 0); 1070 } 1071 }else{ 1072 char *zBusy; 1073 int len; 1074 if( pDb->zBusy ){ 1075 Tcl_Free(pDb->zBusy); 1076 } 1077 zBusy = Tcl_GetStringFromObj(objv[2], &len); 1078 if( zBusy && len>0 ){ 1079 pDb->zBusy = Tcl_Alloc( len + 1 ); 1080 memcpy(pDb->zBusy, zBusy, len+1); 1081 }else{ 1082 pDb->zBusy = 0; 1083 } 1084 if( pDb->zBusy ){ 1085 pDb->interp = interp; 1086 sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb); 1087 }else{ 1088 sqlite3_busy_handler(pDb->db, 0, 0); 1089 } 1090 } 1091 break; 1092 } 1093 1094 /* $db cache flush 1095 ** $db cache size n 1096 ** 1097 ** Flush the prepared statement cache, or set the maximum number of 1098 ** cached statements. 1099 */ 1100 case DB_CACHE: { 1101 char *subCmd; 1102 int n; 1103 1104 if( objc<=2 ){ 1105 Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?"); 1106 return TCL_ERROR; 1107 } 1108 subCmd = Tcl_GetStringFromObj( objv[2], 0 ); 1109 if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){ 1110 if( objc!=3 ){ 1111 Tcl_WrongNumArgs(interp, 2, objv, "flush"); 1112 return TCL_ERROR; 1113 }else{ 1114 flushStmtCache( pDb ); 1115 } 1116 }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){ 1117 if( objc!=4 ){ 1118 Tcl_WrongNumArgs(interp, 2, objv, "size n"); 1119 return TCL_ERROR; 1120 }else{ 1121 if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){ 1122 Tcl_AppendResult( interp, "cannot convert \"", 1123 Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0); 1124 return TCL_ERROR; 1125 }else{ 1126 if( n<0 ){ 1127 flushStmtCache( pDb ); 1128 n = 0; 1129 }else if( n>MAX_PREPARED_STMTS ){ 1130 n = MAX_PREPARED_STMTS; 1131 } 1132 pDb->maxStmt = n; 1133 } 1134 } 1135 }else{ 1136 Tcl_AppendResult( interp, "bad option \"", 1137 Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size", 0); 1138 return TCL_ERROR; 1139 } 1140 break; 1141 } 1142 1143 /* $db changes 1144 ** 1145 ** Return the number of rows that were modified, inserted, or deleted by 1146 ** the most recent INSERT, UPDATE or DELETE statement, not including 1147 ** any changes made by trigger programs. 1148 */ 1149 case DB_CHANGES: { 1150 Tcl_Obj *pResult; 1151 if( objc!=2 ){ 1152 Tcl_WrongNumArgs(interp, 2, objv, ""); 1153 return TCL_ERROR; 1154 } 1155 pResult = Tcl_GetObjResult(interp); 1156 Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db)); 1157 break; 1158 } 1159 1160 /* $db close 1161 ** 1162 ** Shutdown the database 1163 */ 1164 case DB_CLOSE: { 1165 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0)); 1166 break; 1167 } 1168 1169 /* 1170 ** $db collate NAME SCRIPT 1171 ** 1172 ** Create a new SQL collation function called NAME. Whenever 1173 ** that function is called, invoke SCRIPT to evaluate the function. 1174 */ 1175 case DB_COLLATE: { 1176 SqlCollate *pCollate; 1177 char *zName; 1178 char *zScript; 1179 int nScript; 1180 if( objc!=4 ){ 1181 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); 1182 return TCL_ERROR; 1183 } 1184 zName = Tcl_GetStringFromObj(objv[2], 0); 1185 zScript = Tcl_GetStringFromObj(objv[3], &nScript); 1186 pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 ); 1187 if( pCollate==0 ) return TCL_ERROR; 1188 pCollate->interp = interp; 1189 pCollate->pNext = pDb->pCollate; 1190 pCollate->zScript = (char*)&pCollate[1]; 1191 pDb->pCollate = pCollate; 1192 memcpy(pCollate->zScript, zScript, nScript+1); 1193 if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, 1194 pCollate, tclSqlCollate) ){ 1195 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 1196 return TCL_ERROR; 1197 } 1198 break; 1199 } 1200 1201 /* 1202 ** $db collation_needed SCRIPT 1203 ** 1204 ** Create a new SQL collation function called NAME. Whenever 1205 ** that function is called, invoke SCRIPT to evaluate the function. 1206 */ 1207 case DB_COLLATION_NEEDED: { 1208 if( objc!=3 ){ 1209 Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT"); 1210 return TCL_ERROR; 1211 } 1212 if( pDb->pCollateNeeded ){ 1213 Tcl_DecrRefCount(pDb->pCollateNeeded); 1214 } 1215 pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]); 1216 Tcl_IncrRefCount(pDb->pCollateNeeded); 1217 sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded); 1218 break; 1219 } 1220 1221 /* $db commit_hook ?CALLBACK? 1222 ** 1223 ** Invoke the given callback just before committing every SQL transaction. 1224 ** If the callback throws an exception or returns non-zero, then the 1225 ** transaction is aborted. If CALLBACK is an empty string, the callback 1226 ** is disabled. 1227 */ 1228 case DB_COMMIT_HOOK: { 1229 if( objc>3 ){ 1230 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 1231 return TCL_ERROR; 1232 }else if( objc==2 ){ 1233 if( pDb->zCommit ){ 1234 Tcl_AppendResult(interp, pDb->zCommit, 0); 1235 } 1236 }else{ 1237 char *zCommit; 1238 int len; 1239 if( pDb->zCommit ){ 1240 Tcl_Free(pDb->zCommit); 1241 } 1242 zCommit = Tcl_GetStringFromObj(objv[2], &len); 1243 if( zCommit && len>0 ){ 1244 pDb->zCommit = Tcl_Alloc( len + 1 ); 1245 memcpy(pDb->zCommit, zCommit, len+1); 1246 }else{ 1247 pDb->zCommit = 0; 1248 } 1249 if( pDb->zCommit ){ 1250 pDb->interp = interp; 1251 sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb); 1252 }else{ 1253 sqlite3_commit_hook(pDb->db, 0, 0); 1254 } 1255 } 1256 break; 1257 } 1258 1259 /* $db complete SQL 1260 ** 1261 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if 1262 ** additional lines of input are needed. This is similar to the 1263 ** built-in "info complete" command of Tcl. 1264 */ 1265 case DB_COMPLETE: { 1266 #ifndef SQLITE_OMIT_COMPLETE 1267 Tcl_Obj *pResult; 1268 int isComplete; 1269 if( objc!=3 ){ 1270 Tcl_WrongNumArgs(interp, 2, objv, "SQL"); 1271 return TCL_ERROR; 1272 } 1273 isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) ); 1274 pResult = Tcl_GetObjResult(interp); 1275 Tcl_SetBooleanObj(pResult, isComplete); 1276 #endif 1277 break; 1278 } 1279 1280 /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR? 1281 ** 1282 ** Copy data into table from filename, optionally using SEPARATOR 1283 ** as column separators. If a column contains a null string, or the 1284 ** value of NULLINDICATOR, a NULL is inserted for the column. 1285 ** conflict-algorithm is one of the sqlite conflict algorithms: 1286 ** rollback, abort, fail, ignore, replace 1287 ** On success, return the number of lines processed, not necessarily same 1288 ** as 'db changes' due to conflict-algorithm selected. 1289 ** 1290 ** This code is basically an implementation/enhancement of 1291 ** the sqlite3 shell.c ".import" command. 1292 ** 1293 ** This command usage is equivalent to the sqlite2.x COPY statement, 1294 ** which imports file data into a table using the PostgreSQL COPY file format: 1295 ** $db copy $conflit_algo $table_name $filename \t \\N 1296 */ 1297 case DB_COPY: { 1298 char *zTable; /* Insert data into this table */ 1299 char *zFile; /* The file from which to extract data */ 1300 char *zConflict; /* The conflict algorithm to use */ 1301 sqlite3_stmt *pStmt; /* A statement */ 1302 int rc; /* Result code */ 1303 int nCol; /* Number of columns in the table */ 1304 int nByte; /* Number of bytes in an SQL string */ 1305 int i, j; /* Loop counters */ 1306 int nSep; /* Number of bytes in zSep[] */ 1307 int nNull; /* Number of bytes in zNull[] */ 1308 char *zSql; /* An SQL statement */ 1309 char *zLine; /* A single line of input from the file */ 1310 char **azCol; /* zLine[] broken up into columns */ 1311 char *zCommit; /* How to commit changes */ 1312 FILE *in; /* The input file */ 1313 int lineno = 0; /* Line number of input file */ 1314 char zLineNum[80]; /* Line number print buffer */ 1315 Tcl_Obj *pResult; /* interp result */ 1316 1317 char *zSep; 1318 char *zNull; 1319 if( objc<5 || objc>7 ){ 1320 Tcl_WrongNumArgs(interp, 2, objv, 1321 "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"); 1322 return TCL_ERROR; 1323 } 1324 if( objc>=6 ){ 1325 zSep = Tcl_GetStringFromObj(objv[5], 0); 1326 }else{ 1327 zSep = "\t"; 1328 } 1329 if( objc>=7 ){ 1330 zNull = Tcl_GetStringFromObj(objv[6], 0); 1331 }else{ 1332 zNull = ""; 1333 } 1334 zConflict = Tcl_GetStringFromObj(objv[2], 0); 1335 zTable = Tcl_GetStringFromObj(objv[3], 0); 1336 zFile = Tcl_GetStringFromObj(objv[4], 0); 1337 nSep = strlen(zSep); 1338 nNull = strlen(zNull); 1339 if( nSep==0 ){ 1340 Tcl_AppendResult(interp,"Error: non-null separator required for copy",0); 1341 return TCL_ERROR; 1342 } 1343 if(sqlite3StrICmp(zConflict, "rollback") != 0 && 1344 sqlite3StrICmp(zConflict, "abort" ) != 0 && 1345 sqlite3StrICmp(zConflict, "fail" ) != 0 && 1346 sqlite3StrICmp(zConflict, "ignore" ) != 0 && 1347 sqlite3StrICmp(zConflict, "replace" ) != 0 ) { 1348 Tcl_AppendResult(interp, "Error: \"", zConflict, 1349 "\", conflict-algorithm must be one of: rollback, " 1350 "abort, fail, ignore, or replace", 0); 1351 return TCL_ERROR; 1352 } 1353 zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable); 1354 if( zSql==0 ){ 1355 Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0); 1356 return TCL_ERROR; 1357 } 1358 nByte = strlen(zSql); 1359 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); 1360 sqlite3_free(zSql); 1361 if( rc ){ 1362 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); 1363 nCol = 0; 1364 }else{ 1365 nCol = sqlite3_column_count(pStmt); 1366 } 1367 sqlite3_finalize(pStmt); 1368 if( nCol==0 ) { 1369 return TCL_ERROR; 1370 } 1371 zSql = malloc( nByte + 50 + nCol*2 ); 1372 if( zSql==0 ) { 1373 Tcl_AppendResult(interp, "Error: can't malloc()", 0); 1374 return TCL_ERROR; 1375 } 1376 sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?", 1377 zConflict, zTable); 1378 j = strlen(zSql); 1379 for(i=1; i<nCol; i++){ 1380 zSql[j++] = ','; 1381 zSql[j++] = '?'; 1382 } 1383 zSql[j++] = ')'; 1384 zSql[j] = 0; 1385 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); 1386 free(zSql); 1387 if( rc ){ 1388 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); 1389 sqlite3_finalize(pStmt); 1390 return TCL_ERROR; 1391 } 1392 in = fopen(zFile, "rb"); 1393 if( in==0 ){ 1394 Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL); 1395 sqlite3_finalize(pStmt); 1396 return TCL_ERROR; 1397 } 1398 azCol = malloc( sizeof(azCol[0])*(nCol+1) ); 1399 if( azCol==0 ) { 1400 Tcl_AppendResult(interp, "Error: can't malloc()", 0); 1401 fclose(in); 1402 return TCL_ERROR; 1403 } 1404 (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); 1405 zCommit = "COMMIT"; 1406 while( (zLine = local_getline(0, in))!=0 ){ 1407 char *z; 1408 i = 0; 1409 lineno++; 1410 azCol[0] = zLine; 1411 for(i=0, z=zLine; *z; z++){ 1412 if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ 1413 *z = 0; 1414 i++; 1415 if( i<nCol ){ 1416 azCol[i] = &z[nSep]; 1417 z += nSep-1; 1418 } 1419 } 1420 } 1421 if( i+1!=nCol ){ 1422 char *zErr; 1423 int nErr = strlen(zFile) + 200; 1424 zErr = malloc(nErr); 1425 if( zErr ){ 1426 sqlite3_snprintf(nErr, zErr, 1427 "Error: %s line %d: expected %d columns of data but found %d", 1428 zFile, lineno, nCol, i+1); 1429 Tcl_AppendResult(interp, zErr, 0); 1430 free(zErr); 1431 } 1432 zCommit = "ROLLBACK"; 1433 break; 1434 } 1435 for(i=0; i<nCol; i++){ 1436 /* check for null data, if so, bind as null */ 1437 if ((nNull>0 && strcmp(azCol[i], zNull)==0) || strlen(azCol[i])==0) { 1438 sqlite3_bind_null(pStmt, i+1); 1439 }else{ 1440 sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC); 1441 } 1442 } 1443 sqlite3_step(pStmt); 1444 rc = sqlite3_reset(pStmt); 1445 free(zLine); 1446 if( rc!=SQLITE_OK ){ 1447 Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0); 1448 zCommit = "ROLLBACK"; 1449 break; 1450 } 1451 } 1452 free(azCol); 1453 fclose(in); 1454 sqlite3_finalize(pStmt); 1455 (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); 1456 1457 if( zCommit[0] == 'C' ){ 1458 /* success, set result as number of lines processed */ 1459 pResult = Tcl_GetObjResult(interp); 1460 Tcl_SetIntObj(pResult, lineno); 1461 rc = TCL_OK; 1462 }else{ 1463 /* failure, append lineno where failed */ 1464 sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno); 1465 Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0); 1466 rc = TCL_ERROR; 1467 } 1468 break; 1469 } 1470 1471 /* 1472 ** $db enable_load_extension BOOLEAN 1473 ** 1474 ** Turn the extension loading feature on or off. It if off by 1475 ** default. 1476 */ 1477 case DB_ENABLE_LOAD_EXTENSION: { 1478 #ifndef SQLITE_OMIT_LOAD_EXTENSION 1479 int onoff; 1480 if( objc!=3 ){ 1481 Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN"); 1482 return TCL_ERROR; 1483 } 1484 if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){ 1485 return TCL_ERROR; 1486 } 1487 sqlite3_enable_load_extension(pDb->db, onoff); 1488 break; 1489 #else 1490 Tcl_AppendResult(interp, "extension loading is turned off at compile-time", 1491 0); 1492 return TCL_ERROR; 1493 #endif 1494 } 1495 1496 /* 1497 ** $db errorcode 1498 ** 1499 ** Return the numeric error code that was returned by the most recent 1500 ** call to sqlite3_exec(). 1501 */ 1502 case DB_ERRORCODE: { 1503 Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db))); 1504 break; 1505 } 1506 1507 /* 1508 ** $db eval $sql ?array? ?{ ...code... }? 1509 ** $db onecolumn $sql 1510 ** 1511 ** The SQL statement in $sql is evaluated. For each row, the values are 1512 ** placed in elements of the array named "array" and ...code... is executed. 1513 ** If "array" and "code" are omitted, then no callback is every invoked. 1514 ** If "array" is an empty string, then the values are placed in variables 1515 ** that have the same name as the fields extracted by the query. 1516 ** 1517 ** The onecolumn method is the equivalent of: 1518 ** lindex [$db eval $sql] 0 1519 */ 1520 case DB_ONECOLUMN: 1521 case DB_EVAL: 1522 case DB_EXISTS: { 1523 char const *zSql; /* Next SQL statement to execute */ 1524 char const *zLeft; /* What is left after first stmt in zSql */ 1525 sqlite3_stmt *pStmt; /* Compiled SQL statment */ 1526 Tcl_Obj *pArray; /* Name of array into which results are written */ 1527 Tcl_Obj *pScript; /* Script to run for each result set */ 1528 Tcl_Obj **apParm; /* Parameters that need a Tcl_DecrRefCount() */ 1529 int nParm; /* Number of entries used in apParm[] */ 1530 Tcl_Obj *aParm[10]; /* Static space for apParm[] in the common case */ 1531 Tcl_Obj *pRet; /* Value to be returned */ 1532 SqlPreparedStmt *pPreStmt; /* Pointer to a prepared statement */ 1533 int rc2; 1534 1535 if( choice==DB_EVAL ){ 1536 if( objc<3 || objc>5 ){ 1537 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); 1538 return TCL_ERROR; 1539 } 1540 pRet = Tcl_NewObj(); 1541 Tcl_IncrRefCount(pRet); 1542 }else{ 1543 if( objc!=3 ){ 1544 Tcl_WrongNumArgs(interp, 2, objv, "SQL"); 1545 return TCL_ERROR; 1546 } 1547 if( choice==DB_EXISTS ){ 1548 pRet = Tcl_NewBooleanObj(0); 1549 Tcl_IncrRefCount(pRet); 1550 }else{ 1551 pRet = 0; 1552 } 1553 } 1554 if( objc==3 ){ 1555 pArray = pScript = 0; 1556 }else if( objc==4 ){ 1557 pArray = 0; 1558 pScript = objv[3]; 1559 }else{ 1560 pArray = objv[3]; 1561 if( Tcl_GetString(pArray)[0]==0 ) pArray = 0; 1562 pScript = objv[4]; 1563 } 1564 1565 Tcl_IncrRefCount(objv[2]); 1566 zSql = Tcl_GetStringFromObj(objv[2], 0); 1567 while( rc==TCL_OK && zSql[0] ){ 1568 int i; /* Loop counter */ 1569 int nVar; /* Number of bind parameters in the pStmt */ 1570 int nCol = -1; /* Number of columns in the result set */ 1571 Tcl_Obj **apColName = 0; /* Array of column names */ 1572 int len; /* String length of zSql */ 1573 1574 /* Try to find a SQL statement that has already been compiled and 1575 ** which matches the next sequence of SQL. 1576 */ 1577 pStmt = 0; 1578 len = strlen(zSql); 1579 for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){ 1580 int n = pPreStmt->nSql; 1581 if( len>=n 1582 && memcmp(pPreStmt->zSql, zSql, n)==0 1583 && (zSql[n]==0 || zSql[n-1]==';') 1584 ){ 1585 pStmt = pPreStmt->pStmt; 1586 zLeft = &zSql[pPreStmt->nSql]; 1587 1588 /* When a prepared statement is found, unlink it from the 1589 ** cache list. It will later be added back to the beginning 1590 ** of the cache list in order to implement LRU replacement. 1591 */ 1592 if( pPreStmt->pPrev ){ 1593 pPreStmt->pPrev->pNext = pPreStmt->pNext; 1594 }else{ 1595 pDb->stmtList = pPreStmt->pNext; 1596 } 1597 if( pPreStmt->pNext ){ 1598 pPreStmt->pNext->pPrev = pPreStmt->pPrev; 1599 }else{ 1600 pDb->stmtLast = pPreStmt->pPrev; 1601 } 1602 pDb->nStmt--; 1603 break; 1604 } 1605 } 1606 1607 /* If no prepared statement was found. Compile the SQL text 1608 */ 1609 if( pStmt==0 ){ 1610 if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, &zLeft) ){ 1611 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1612 rc = TCL_ERROR; 1613 break; 1614 } 1615 if( pStmt==0 ){ 1616 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ 1617 /* A compile-time error in the statement 1618 */ 1619 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1620 rc = TCL_ERROR; 1621 break; 1622 }else{ 1623 /* The statement was a no-op. Continue to the next statement 1624 ** in the SQL string. 1625 */ 1626 zSql = zLeft; 1627 continue; 1628 } 1629 } 1630 assert( pPreStmt==0 ); 1631 } 1632 1633 /* Bind values to parameters that begin with $ or : 1634 */ 1635 nVar = sqlite3_bind_parameter_count(pStmt); 1636 nParm = 0; 1637 if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){ 1638 apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0])); 1639 }else{ 1640 apParm = aParm; 1641 } 1642 for(i=1; i<=nVar; i++){ 1643 const char *zVar = sqlite3_bind_parameter_name(pStmt, i); 1644 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){ 1645 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0); 1646 if( pVar ){ 1647 int n; 1648 u8 *data; 1649 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 1650 char c = zType[0]; 1651 if( zVar[0]=='@' || 1652 (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){ 1653 /* Load a BLOB type if the Tcl variable is a bytearray and 1654 ** it has no string representation or the host 1655 ** parameter name begins with "@". */ 1656 data = Tcl_GetByteArrayFromObj(pVar, &n); 1657 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); 1658 Tcl_IncrRefCount(pVar); 1659 apParm[nParm++] = pVar; 1660 }else if( c=='b' && strcmp(zType,"boolean")==0 ){ 1661 Tcl_GetIntFromObj(interp, pVar, &n); 1662 sqlite3_bind_int(pStmt, i, n); 1663 }else if( c=='d' && strcmp(zType,"double")==0 ){ 1664 double r; 1665 Tcl_GetDoubleFromObj(interp, pVar, &r); 1666 sqlite3_bind_double(pStmt, i, r); 1667 }else if( (c=='w' && strcmp(zType,"wideInt")==0) || 1668 (c=='i' && strcmp(zType,"int")==0) ){ 1669 Tcl_WideInt v; 1670 Tcl_GetWideIntFromObj(interp, pVar, &v); 1671 sqlite3_bind_int64(pStmt, i, v); 1672 }else{ 1673 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 1674 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); 1675 Tcl_IncrRefCount(pVar); 1676 apParm[nParm++] = pVar; 1677 } 1678 }else{ 1679 sqlite3_bind_null( pStmt, i ); 1680 } 1681 } 1682 } 1683 1684 /* Execute the SQL 1685 */ 1686 while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){ 1687 1688 /* Compute column names. This must be done after the first successful 1689 ** call to sqlite3_step(), in case the query is recompiled and the 1690 ** number or names of the returned columns changes. 1691 */ 1692 assert(!pArray||pScript); 1693 if (nCol < 0) { 1694 Tcl_Obj ***ap = (pScript?&apColName:0); 1695 nCol = computeColumnNames(interp, pStmt, ap, pArray); 1696 } 1697 1698 for(i=0; i<nCol; i++){ 1699 Tcl_Obj *pVal; 1700 1701 /* Set pVal to contain the i'th column of this row. */ 1702 switch( sqlite3_column_type(pStmt, i) ){ 1703 case SQLITE_BLOB: { 1704 int bytes = sqlite3_column_bytes(pStmt, i); 1705 pVal = Tcl_NewByteArrayObj(sqlite3_column_blob(pStmt, i), bytes); 1706 break; 1707 } 1708 case SQLITE_INTEGER: { 1709 sqlite_int64 v = sqlite3_column_int64(pStmt, i); 1710 if( v>=-2147483647 && v<=2147483647 ){ 1711 pVal = Tcl_NewIntObj(v); 1712 }else{ 1713 pVal = Tcl_NewWideIntObj(v); 1714 } 1715 break; 1716 } 1717 case SQLITE_FLOAT: { 1718 double r = sqlite3_column_double(pStmt, i); 1719 pVal = Tcl_NewDoubleObj(r); 1720 break; 1721 } 1722 case SQLITE_NULL: { 1723 pVal = dbTextToObj(pDb->zNull); 1724 break; 1725 } 1726 default: { 1727 pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i)); 1728 break; 1729 } 1730 } 1731 1732 if( pScript ){ 1733 if( pArray==0 ){ 1734 Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); 1735 }else{ 1736 Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); 1737 } 1738 }else if( choice==DB_ONECOLUMN ){ 1739 assert( pRet==0 ); 1740 if( pRet==0 ){ 1741 pRet = pVal; 1742 Tcl_IncrRefCount(pRet); 1743 } 1744 rc = TCL_BREAK; 1745 i = nCol; 1746 }else if( choice==DB_EXISTS ){ 1747 Tcl_DecrRefCount(pRet); 1748 pRet = Tcl_NewBooleanObj(1); 1749 Tcl_IncrRefCount(pRet); 1750 rc = TCL_BREAK; 1751 i = nCol; 1752 }else{ 1753 Tcl_ListObjAppendElement(interp, pRet, pVal); 1754 } 1755 } 1756 1757 if( pScript ){ 1758 rc = Tcl_EvalObjEx(interp, pScript, 0); 1759 if( rc==TCL_CONTINUE ){ 1760 rc = TCL_OK; 1761 } 1762 } 1763 } 1764 if( rc==TCL_BREAK ){ 1765 rc = TCL_OK; 1766 } 1767 1768 /* Free the column name objects */ 1769 if( pScript ){ 1770 /* If the query returned no rows, but an array variable was 1771 ** specified, call computeColumnNames() now to populate the 1772 ** arrayname(*) variable. 1773 */ 1774 if (pArray && nCol < 0) { 1775 Tcl_Obj ***ap = (pScript?&apColName:0); 1776 nCol = computeColumnNames(interp, pStmt, ap, pArray); 1777 } 1778 for(i=0; i<nCol; i++){ 1779 Tcl_DecrRefCount(apColName[i]); 1780 } 1781 Tcl_Free((char*)apColName); 1782 } 1783 1784 /* Free the bound string and blob parameters */ 1785 for(i=0; i<nParm; i++){ 1786 Tcl_DecrRefCount(apParm[i]); 1787 } 1788 if( apParm!=aParm ){ 1789 Tcl_Free((char*)apParm); 1790 } 1791 1792 /* Reset the statement. If the result code is SQLITE_SCHEMA, then 1793 ** flush the statement cache and try the statement again. 1794 */ 1795 rc2 = sqlite3_reset(pStmt); 1796 if( SQLITE_OK!=rc2 ){ 1797 /* If a run-time error occurs, report the error and stop reading 1798 ** the SQL 1799 */ 1800 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1801 sqlite3_finalize(pStmt); 1802 rc = TCL_ERROR; 1803 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1804 break; 1805 }else if( pDb->maxStmt<=0 ){ 1806 /* If the cache is turned off, deallocated the statement */ 1807 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1808 sqlite3_finalize(pStmt); 1809 }else{ 1810 /* Everything worked and the cache is operational. 1811 ** Create a new SqlPreparedStmt structure if we need one. 1812 ** (If we already have one we can just reuse it.) 1813 */ 1814 if( pPreStmt==0 ){ 1815 len = zLeft - zSql; 1816 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) ); 1817 if( pPreStmt==0 ) return TCL_ERROR; 1818 pPreStmt->pStmt = pStmt; 1819 pPreStmt->nSql = len; 1820 pPreStmt->zSql = sqlite3_sql(pStmt); 1821 assert( strlen(pPreStmt->zSql)==len ); 1822 assert( 0==memcmp(pPreStmt->zSql, zSql, len) ); 1823 } 1824 1825 /* Add the prepared statement to the beginning of the cache list 1826 */ 1827 pPreStmt->pNext = pDb->stmtList; 1828 pPreStmt->pPrev = 0; 1829 if( pDb->stmtList ){ 1830 pDb->stmtList->pPrev = pPreStmt; 1831 } 1832 pDb->stmtList = pPreStmt; 1833 if( pDb->stmtLast==0 ){ 1834 assert( pDb->nStmt==0 ); 1835 pDb->stmtLast = pPreStmt; 1836 }else{ 1837 assert( pDb->nStmt>0 ); 1838 } 1839 pDb->nStmt++; 1840 1841 /* If we have too many statement in cache, remove the surplus from the 1842 ** end of the cache list. 1843 */ 1844 while( pDb->nStmt>pDb->maxStmt ){ 1845 sqlite3_finalize(pDb->stmtLast->pStmt); 1846 pDb->stmtLast = pDb->stmtLast->pPrev; 1847 Tcl_Free((char*)pDb->stmtLast->pNext); 1848 pDb->stmtLast->pNext = 0; 1849 pDb->nStmt--; 1850 } 1851 } 1852 1853 /* Proceed to the next statement */ 1854 zSql = zLeft; 1855 } 1856 Tcl_DecrRefCount(objv[2]); 1857 1858 if( pRet ){ 1859 if( rc==TCL_OK ){ 1860 Tcl_SetObjResult(interp, pRet); 1861 } 1862 Tcl_DecrRefCount(pRet); 1863 }else if( rc==TCL_OK ){ 1864 Tcl_ResetResult(interp); 1865 } 1866 break; 1867 } 1868 1869 /* 1870 ** $db function NAME SCRIPT 1871 ** 1872 ** Create a new SQL function called NAME. Whenever that function is 1873 ** called, invoke SCRIPT to evaluate the function. 1874 */ 1875 case DB_FUNCTION: { 1876 SqlFunc *pFunc; 1877 Tcl_Obj *pScript; 1878 char *zName; 1879 if( objc!=4 ){ 1880 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); 1881 return TCL_ERROR; 1882 } 1883 zName = Tcl_GetStringFromObj(objv[2], 0); 1884 pScript = objv[3]; 1885 pFunc = findSqlFunc(pDb, zName); 1886 if( pFunc==0 ) return TCL_ERROR; 1887 if( pFunc->pScript ){ 1888 Tcl_DecrRefCount(pFunc->pScript); 1889 } 1890 pFunc->pScript = pScript; 1891 Tcl_IncrRefCount(pScript); 1892 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); 1893 rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8, 1894 pFunc, tclSqlFunc, 0, 0); 1895 if( rc!=SQLITE_OK ){ 1896 rc = TCL_ERROR; 1897 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 1898 } 1899 break; 1900 } 1901 1902 /* 1903 ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID 1904 */ 1905 case DB_INCRBLOB: { 1906 #ifdef SQLITE_OMIT_INCRBLOB 1907 Tcl_AppendResult(interp, "incrblob not available in this build", 0); 1908 return TCL_ERROR; 1909 #else 1910 int isReadonly = 0; 1911 const char *zDb = "main"; 1912 const char *zTable; 1913 const char *zColumn; 1914 sqlite_int64 iRow; 1915 1916 /* Check for the -readonly option */ 1917 if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){ 1918 isReadonly = 1; 1919 } 1920 1921 if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){ 1922 Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID"); 1923 return TCL_ERROR; 1924 } 1925 1926 if( objc==(6+isReadonly) ){ 1927 zDb = Tcl_GetString(objv[2]); 1928 } 1929 zTable = Tcl_GetString(objv[objc-3]); 1930 zColumn = Tcl_GetString(objv[objc-2]); 1931 rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow); 1932 1933 if( rc==TCL_OK ){ 1934 rc = createIncrblobChannel( 1935 interp, pDb, zDb, zTable, zColumn, iRow, isReadonly 1936 ); 1937 } 1938 #endif 1939 break; 1940 } 1941 1942 /* 1943 ** $db interrupt 1944 ** 1945 ** Interrupt the execution of the inner-most SQL interpreter. This 1946 ** causes the SQL statement to return an error of SQLITE_INTERRUPT. 1947 */ 1948 case DB_INTERRUPT: { 1949 sqlite3_interrupt(pDb->db); 1950 break; 1951 } 1952 1953 /* 1954 ** $db nullvalue ?STRING? 1955 ** 1956 ** Change text used when a NULL comes back from the database. If ?STRING? 1957 ** is not present, then the current string used for NULL is returned. 1958 ** If STRING is present, then STRING is returned. 1959 ** 1960 */ 1961 case DB_NULLVALUE: { 1962 if( objc!=2 && objc!=3 ){ 1963 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE"); 1964 return TCL_ERROR; 1965 } 1966 if( objc==3 ){ 1967 int len; 1968 char *zNull = Tcl_GetStringFromObj(objv[2], &len); 1969 if( pDb->zNull ){ 1970 Tcl_Free(pDb->zNull); 1971 } 1972 if( zNull && len>0 ){ 1973 pDb->zNull = Tcl_Alloc( len + 1 ); 1974 strncpy(pDb->zNull, zNull, len); 1975 pDb->zNull[len] = '\0'; 1976 }else{ 1977 pDb->zNull = 0; 1978 } 1979 } 1980 Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull)); 1981 break; 1982 } 1983 1984 /* 1985 ** $db last_insert_rowid 1986 ** 1987 ** Return an integer which is the ROWID for the most recent insert. 1988 */ 1989 case DB_LAST_INSERT_ROWID: { 1990 Tcl_Obj *pResult; 1991 Tcl_WideInt rowid; 1992 if( objc!=2 ){ 1993 Tcl_WrongNumArgs(interp, 2, objv, ""); 1994 return TCL_ERROR; 1995 } 1996 rowid = sqlite3_last_insert_rowid(pDb->db); 1997 pResult = Tcl_GetObjResult(interp); 1998 Tcl_SetWideIntObj(pResult, rowid); 1999 break; 2000 } 2001 2002 /* 2003 ** The DB_ONECOLUMN method is implemented together with DB_EVAL. 2004 */ 2005 2006 /* $db progress ?N CALLBACK? 2007 ** 2008 ** Invoke the given callback every N virtual machine opcodes while executing 2009 ** queries. 2010 */ 2011 case DB_PROGRESS: { 2012 if( objc==2 ){ 2013 if( pDb->zProgress ){ 2014 Tcl_AppendResult(interp, pDb->zProgress, 0); 2015 } 2016 }else if( objc==4 ){ 2017 char *zProgress; 2018 int len; 2019 int N; 2020 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){ 2021 return TCL_ERROR; 2022 }; 2023 if( pDb->zProgress ){ 2024 Tcl_Free(pDb->zProgress); 2025 } 2026 zProgress = Tcl_GetStringFromObj(objv[3], &len); 2027 if( zProgress && len>0 ){ 2028 pDb->zProgress = Tcl_Alloc( len + 1 ); 2029 memcpy(pDb->zProgress, zProgress, len+1); 2030 }else{ 2031 pDb->zProgress = 0; 2032 } 2033 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK 2034 if( pDb->zProgress ){ 2035 pDb->interp = interp; 2036 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); 2037 }else{ 2038 sqlite3_progress_handler(pDb->db, 0, 0, 0); 2039 } 2040 #endif 2041 }else{ 2042 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK"); 2043 return TCL_ERROR; 2044 } 2045 break; 2046 } 2047 2048 /* $db profile ?CALLBACK? 2049 ** 2050 ** Make arrangements to invoke the CALLBACK routine after each SQL statement 2051 ** that has run. The text of the SQL and the amount of elapse time are 2052 ** appended to CALLBACK before the script is run. 2053 */ 2054 case DB_PROFILE: { 2055 if( objc>3 ){ 2056 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 2057 return TCL_ERROR; 2058 }else if( objc==2 ){ 2059 if( pDb->zProfile ){ 2060 Tcl_AppendResult(interp, pDb->zProfile, 0); 2061 } 2062 }else{ 2063 char *zProfile; 2064 int len; 2065 if( pDb->zProfile ){ 2066 Tcl_Free(pDb->zProfile); 2067 } 2068 zProfile = Tcl_GetStringFromObj(objv[2], &len); 2069 if( zProfile && len>0 ){ 2070 pDb->zProfile = Tcl_Alloc( len + 1 ); 2071 memcpy(pDb->zProfile, zProfile, len+1); 2072 }else{ 2073 pDb->zProfile = 0; 2074 } 2075 #ifndef SQLITE_OMIT_TRACE 2076 if( pDb->zProfile ){ 2077 pDb->interp = interp; 2078 sqlite3_profile(pDb->db, DbProfileHandler, pDb); 2079 }else{ 2080 sqlite3_profile(pDb->db, 0, 0); 2081 } 2082 #endif 2083 } 2084 break; 2085 } 2086 2087 /* 2088 ** $db rekey KEY 2089 ** 2090 ** Change the encryption key on the currently open database. 2091 */ 2092 case DB_REKEY: { 2093 int nKey; 2094 void *pKey; 2095 if( objc!=3 ){ 2096 Tcl_WrongNumArgs(interp, 2, objv, "KEY"); 2097 return TCL_ERROR; 2098 } 2099 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey); 2100 #ifdef SQLITE_HAS_CODEC 2101 rc = sqlite3_rekey(pDb->db, pKey, nKey); 2102 if( rc ){ 2103 Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0); 2104 rc = TCL_ERROR; 2105 } 2106 #endif 2107 break; 2108 } 2109 2110 /* 2111 ** $db timeout MILLESECONDS 2112 ** 2113 ** Delay for the number of milliseconds specified when a file is locked. 2114 */ 2115 case DB_TIMEOUT: { 2116 int ms; 2117 if( objc!=3 ){ 2118 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); 2119 return TCL_ERROR; 2120 } 2121 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR; 2122 sqlite3_busy_timeout(pDb->db, ms); 2123 break; 2124 } 2125 2126 /* 2127 ** $db total_changes 2128 ** 2129 ** Return the number of rows that were modified, inserted, or deleted 2130 ** since the database handle was created. 2131 */ 2132 case DB_TOTAL_CHANGES: { 2133 Tcl_Obj *pResult; 2134 if( objc!=2 ){ 2135 Tcl_WrongNumArgs(interp, 2, objv, ""); 2136 return TCL_ERROR; 2137 } 2138 pResult = Tcl_GetObjResult(interp); 2139 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db)); 2140 break; 2141 } 2142 2143 /* $db trace ?CALLBACK? 2144 ** 2145 ** Make arrangements to invoke the CALLBACK routine for each SQL statement 2146 ** that is executed. The text of the SQL is appended to CALLBACK before 2147 ** it is executed. 2148 */ 2149 case DB_TRACE: { 2150 if( objc>3 ){ 2151 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 2152 return TCL_ERROR; 2153 }else if( objc==2 ){ 2154 if( pDb->zTrace ){ 2155 Tcl_AppendResult(interp, pDb->zTrace, 0); 2156 } 2157 }else{ 2158 char *zTrace; 2159 int len; 2160 if( pDb->zTrace ){ 2161 Tcl_Free(pDb->zTrace); 2162 } 2163 zTrace = Tcl_GetStringFromObj(objv[2], &len); 2164 if( zTrace && len>0 ){ 2165 pDb->zTrace = Tcl_Alloc( len + 1 ); 2166 memcpy(pDb->zTrace, zTrace, len+1); 2167 }else{ 2168 pDb->zTrace = 0; 2169 } 2170 #ifndef SQLITE_OMIT_TRACE 2171 if( pDb->zTrace ){ 2172 pDb->interp = interp; 2173 sqlite3_trace(pDb->db, DbTraceHandler, pDb); 2174 }else{ 2175 sqlite3_trace(pDb->db, 0, 0); 2176 } 2177 #endif 2178 } 2179 break; 2180 } 2181 2182 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT 2183 ** 2184 ** Start a new transaction (if we are not already in the midst of a 2185 ** transaction) and execute the TCL script SCRIPT. After SCRIPT 2186 ** completes, either commit the transaction or roll it back if SCRIPT 2187 ** throws an exception. Or if no new transation was started, do nothing. 2188 ** pass the exception on up the stack. 2189 ** 2190 ** This command was inspired by Dave Thomas's talk on Ruby at the 2191 ** 2005 O'Reilly Open Source Convention (OSCON). 2192 */ 2193 case DB_TRANSACTION: { 2194 int inTrans; 2195 Tcl_Obj *pScript; 2196 const char *zBegin = "BEGIN"; 2197 if( objc!=3 && objc!=4 ){ 2198 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); 2199 return TCL_ERROR; 2200 } 2201 if( objc==3 ){ 2202 pScript = objv[2]; 2203 } else { 2204 static const char *TTYPE_strs[] = { 2205 "deferred", "exclusive", "immediate", 0 2206 }; 2207 enum TTYPE_enum { 2208 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE 2209 }; 2210 int ttype; 2211 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type", 2212 0, &ttype) ){ 2213 return TCL_ERROR; 2214 } 2215 switch( (enum TTYPE_enum)ttype ){ 2216 case TTYPE_DEFERRED: /* no-op */; break; 2217 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; 2218 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; 2219 } 2220 pScript = objv[3]; 2221 } 2222 inTrans = !sqlite3_get_autocommit(pDb->db); 2223 if( !inTrans ){ 2224 (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0); 2225 } 2226 rc = Tcl_EvalObjEx(interp, pScript, 0); 2227 if( !inTrans ){ 2228 const char *zEnd; 2229 if( rc==TCL_ERROR ){ 2230 zEnd = "ROLLBACK"; 2231 } else { 2232 zEnd = "COMMIT"; 2233 } 2234 if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ 2235 sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); 2236 } 2237 } 2238 break; 2239 } 2240 2241 /* 2242 ** $db update_hook ?script? 2243 ** $db rollback_hook ?script? 2244 */ 2245 case DB_UPDATE_HOOK: 2246 case DB_ROLLBACK_HOOK: { 2247 2248 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on 2249 ** whether [$db update_hook] or [$db rollback_hook] was invoked. 2250 */ 2251 Tcl_Obj **ppHook; 2252 if( choice==DB_UPDATE_HOOK ){ 2253 ppHook = &pDb->pUpdateHook; 2254 }else{ 2255 ppHook = &pDb->pRollbackHook; 2256 } 2257 2258 if( objc!=2 && objc!=3 ){ 2259 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); 2260 return TCL_ERROR; 2261 } 2262 if( *ppHook ){ 2263 Tcl_SetObjResult(interp, *ppHook); 2264 if( objc==3 ){ 2265 Tcl_DecrRefCount(*ppHook); 2266 *ppHook = 0; 2267 } 2268 } 2269 if( objc==3 ){ 2270 assert( !(*ppHook) ); 2271 if( Tcl_GetCharLength(objv[2])>0 ){ 2272 *ppHook = objv[2]; 2273 Tcl_IncrRefCount(*ppHook); 2274 } 2275 } 2276 2277 sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); 2278 sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); 2279 2280 break; 2281 } 2282 2283 /* $db version 2284 ** 2285 ** Return the version string for this database. 2286 */ 2287 case DB_VERSION: { 2288 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC); 2289 break; 2290 } 2291 2292 2293 } /* End of the SWITCH statement */ 2294 return rc; 2295 } 2296 2297 /* 2298 ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? 2299 ** ?-create BOOLEAN? 2300 ** 2301 ** This is the main Tcl command. When the "sqlite" Tcl command is 2302 ** invoked, this routine runs to process that command. 2303 ** 2304 ** The first argument, DBNAME, is an arbitrary name for a new 2305 ** database connection. This command creates a new command named 2306 ** DBNAME that is used to control that connection. The database 2307 ** connection is deleted when the DBNAME command is deleted. 2308 ** 2309 ** The second argument is the name of the database file. 2310 ** 2311 */ 2312 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 2313 SqliteDb *p; 2314 void *pKey = 0; 2315 int nKey = 0; 2316 const char *zArg; 2317 char *zErrMsg; 2318 int i; 2319 const char *zFile; 2320 const char *zVfs = 0; 2321 int flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE; 2322 Tcl_DString translatedFilename; 2323 if( objc==2 ){ 2324 zArg = Tcl_GetStringFromObj(objv[1], 0); 2325 if( strcmp(zArg,"-version")==0 ){ 2326 Tcl_AppendResult(interp,sqlite3_version,0); 2327 return TCL_OK; 2328 } 2329 if( strcmp(zArg,"-has-codec")==0 ){ 2330 #ifdef SQLITE_HAS_CODEC 2331 Tcl_AppendResult(interp,"1",0); 2332 #else 2333 Tcl_AppendResult(interp,"0",0); 2334 #endif 2335 return TCL_OK; 2336 } 2337 } 2338 for(i=3; i+1<objc; i+=2){ 2339 zArg = Tcl_GetString(objv[i]); 2340 if( strcmp(zArg,"-key")==0 ){ 2341 pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey); 2342 }else if( strcmp(zArg, "-vfs")==0 ){ 2343 i++; 2344 zVfs = Tcl_GetString(objv[i]); 2345 }else if( strcmp(zArg, "-readonly")==0 ){ 2346 int b; 2347 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2348 if( b ){ 2349 flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE); 2350 flags |= SQLITE_OPEN_READONLY; 2351 }else{ 2352 flags &= ~SQLITE_OPEN_READONLY; 2353 flags |= SQLITE_OPEN_READWRITE; 2354 } 2355 }else if( strcmp(zArg, "-create")==0 ){ 2356 int b; 2357 if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR; 2358 if( b && (flags & SQLITE_OPEN_READONLY)==0 ){ 2359 flags |= SQLITE_OPEN_CREATE; 2360 }else{ 2361 flags &= ~SQLITE_OPEN_CREATE; 2362 } 2363 }else{ 2364 Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0); 2365 return TCL_ERROR; 2366 } 2367 } 2368 if( objc<3 || (objc&1)!=1 ){ 2369 Tcl_WrongNumArgs(interp, 1, objv, 2370 "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?" 2371 #ifdef SQLITE_HAS_CODEC 2372 " ?-key CODECKEY?" 2373 #endif 2374 ); 2375 return TCL_ERROR; 2376 } 2377 zErrMsg = 0; 2378 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) ); 2379 if( p==0 ){ 2380 Tcl_SetResult(interp, "malloc failed", TCL_STATIC); 2381 return TCL_ERROR; 2382 } 2383 memset(p, 0, sizeof(*p)); 2384 zFile = Tcl_GetStringFromObj(objv[2], 0); 2385 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename); 2386 sqlite3_open_v2(zFile, &p->db, flags, zVfs); 2387 Tcl_DStringFree(&translatedFilename); 2388 if( SQLITE_OK!=sqlite3_errcode(p->db) ){ 2389 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); 2390 sqlite3_close(p->db); 2391 p->db = 0; 2392 } 2393 #ifdef SQLITE_TEST 2394 if( p->db ){ 2395 extern int Md5_Register(sqlite3*); 2396 if( Md5_Register(p->db)==SQLITE_NOMEM ){ 2397 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); 2398 sqlite3_close(p->db); 2399 p->db = 0; 2400 } 2401 } 2402 #endif 2403 #ifdef SQLITE_HAS_CODEC 2404 if( p->db ){ 2405 sqlite3_key(p->db, pKey, nKey); 2406 } 2407 #endif 2408 if( p->db==0 ){ 2409 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); 2410 Tcl_Free((char*)p); 2411 sqlite3_free(zErrMsg); 2412 return TCL_ERROR; 2413 } 2414 p->maxStmt = NUM_PREPARED_STMTS; 2415 p->interp = interp; 2416 zArg = Tcl_GetStringFromObj(objv[1], 0); 2417 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); 2418 return TCL_OK; 2419 } 2420 2421 /* 2422 ** Provide a dummy Tcl_InitStubs if we are using this as a static 2423 ** library. 2424 */ 2425 #ifndef USE_TCL_STUBS 2426 # undef Tcl_InitStubs 2427 # define Tcl_InitStubs(a,b,c) 2428 #endif 2429 2430 /* 2431 ** Make sure we have a PACKAGE_VERSION macro defined. This will be 2432 ** defined automatically by the TEA makefile. But other makefiles 2433 ** do not define it. 2434 */ 2435 #ifndef PACKAGE_VERSION 2436 # define PACKAGE_VERSION SQLITE_VERSION 2437 #endif 2438 2439 /* 2440 ** Initialize this module. 2441 ** 2442 ** This Tcl module contains only a single new Tcl command named "sqlite". 2443 ** (Hence there is no namespace. There is no point in using a namespace 2444 ** if the extension only supplies one new name!) The "sqlite" command is 2445 ** used to open a new SQLite database. See the DbMain() routine above 2446 ** for additional information. 2447 */ 2448 EXTERN int Sqlite3_Init(Tcl_Interp *interp){ 2449 Tcl_InitStubs(interp, "8.4", 0); 2450 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2451 Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION); 2452 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2453 Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION); 2454 return TCL_OK; 2455 } 2456 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2457 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2458 EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2459 2460 #ifndef SQLITE_3_SUFFIX_ONLY 2461 EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2462 EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2463 EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2464 EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2465 #endif 2466 2467 #ifdef TCLSH 2468 /***************************************************************************** 2469 ** The code that follows is used to build standalone TCL interpreters 2470 ** that are statically linked with SQLite. 2471 */ 2472 2473 /* 2474 ** If the macro TCLSH is one, then put in code this for the 2475 ** "main" routine that will initialize Tcl and take input from 2476 ** standard input, or if a file is named on the command line 2477 ** the TCL interpreter reads and evaluates that file. 2478 */ 2479 #if TCLSH==1 2480 static char zMainloop[] = 2481 "set line {}\n" 2482 "while {![eof stdin]} {\n" 2483 "if {$line!=\"\"} {\n" 2484 "puts -nonewline \"> \"\n" 2485 "} else {\n" 2486 "puts -nonewline \"% \"\n" 2487 "}\n" 2488 "flush stdout\n" 2489 "append line [gets stdin]\n" 2490 "if {[info complete $line]} {\n" 2491 "if {[catch {uplevel #0 $line} result]} {\n" 2492 "puts stderr \"Error: $result\"\n" 2493 "} elseif {$result!=\"\"} {\n" 2494 "puts $result\n" 2495 "}\n" 2496 "set line {}\n" 2497 "} else {\n" 2498 "append line \\n\n" 2499 "}\n" 2500 "}\n" 2501 ; 2502 #endif 2503 2504 /* 2505 ** If the macro TCLSH is two, then get the main loop code out of 2506 ** the separate file "spaceanal_tcl.h". 2507 */ 2508 #if TCLSH==2 2509 static char zMainloop[] = 2510 #include "spaceanal_tcl.h" 2511 ; 2512 #endif 2513 2514 #define TCLSH_MAIN main /* Needed to fake out mktclapp */ 2515 int TCLSH_MAIN(int argc, char **argv){ 2516 Tcl_Interp *interp; 2517 Tcl_FindExecutable(argv[0]); 2518 interp = Tcl_CreateInterp(); 2519 Sqlite3_Init(interp); 2520 #ifdef SQLITE_TEST 2521 { 2522 extern int Md5_Init(Tcl_Interp*); 2523 extern int Sqliteconfig_Init(Tcl_Interp*); 2524 extern int Sqlitetest1_Init(Tcl_Interp*); 2525 extern int Sqlitetest2_Init(Tcl_Interp*); 2526 extern int Sqlitetest3_Init(Tcl_Interp*); 2527 extern int Sqlitetest4_Init(Tcl_Interp*); 2528 extern int Sqlitetest5_Init(Tcl_Interp*); 2529 extern int Sqlitetest6_Init(Tcl_Interp*); 2530 extern int Sqlitetest7_Init(Tcl_Interp*); 2531 extern int Sqlitetest8_Init(Tcl_Interp*); 2532 extern int Sqlitetest9_Init(Tcl_Interp*); 2533 extern int Sqlitetestasync_Init(Tcl_Interp*); 2534 extern int Sqlitetest_autoext_Init(Tcl_Interp*); 2535 extern int Sqlitetest_hexio_Init(Tcl_Interp*); 2536 extern int Sqlitetest_malloc_Init(Tcl_Interp*); 2537 extern int Sqlitetestschema_Init(Tcl_Interp*); 2538 extern int Sqlitetestsse_Init(Tcl_Interp*); 2539 extern int Sqlitetesttclvar_Init(Tcl_Interp*); 2540 extern int SqlitetestThread_Init(Tcl_Interp*); 2541 extern int SqlitetestOnefile_Init(); 2542 2543 Md5_Init(interp); 2544 Sqliteconfig_Init(interp); 2545 Sqlitetest1_Init(interp); 2546 Sqlitetest2_Init(interp); 2547 Sqlitetest3_Init(interp); 2548 Sqlitetest4_Init(interp); 2549 Sqlitetest5_Init(interp); 2550 Sqlitetest6_Init(interp); 2551 Sqlitetest7_Init(interp); 2552 Sqlitetest8_Init(interp); 2553 Sqlitetest9_Init(interp); 2554 Sqlitetestasync_Init(interp); 2555 Sqlitetest_autoext_Init(interp); 2556 Sqlitetest_hexio_Init(interp); 2557 Sqlitetest_malloc_Init(interp); 2558 Sqlitetestschema_Init(interp); 2559 Sqlitetesttclvar_Init(interp); 2560 SqlitetestThread_Init(interp); 2561 SqlitetestOnefile_Init(interp); 2562 2563 #ifdef SQLITE_SSE 2564 Sqlitetestsse_Init(interp); 2565 #endif 2566 } 2567 #endif 2568 if( argc>=2 || TCLSH==2 ){ 2569 int i; 2570 char zArgc[32]; 2571 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH)); 2572 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY); 2573 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); 2574 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); 2575 for(i=3-TCLSH; i<argc; i++){ 2576 Tcl_SetVar(interp, "argv", argv[i], 2577 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); 2578 } 2579 if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ 2580 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); 2581 if( zInfo==0 ) zInfo = interp->result; 2582 fprintf(stderr,"%s: %s\n", *argv, zInfo); 2583 return 1; 2584 } 2585 } 2586 if( argc<=1 || TCLSH==2 ){ 2587 Tcl_GlobalEval(interp, zMainloop); 2588 } 2589 return 0; 2590 } 2591 #endif /* TCLSH */ 2592