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