4 ** The author disclaims copyright to this source code. In place of
5 ** a legal notice, here is a blessing:
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.
11 *************************************************************************
14 #include "sqliteInt.h"
15 #if defined(INCLUDE_SQLITE_TCL_H)
16 # include "sqlite_tcl.h"
23 #ifndef SQLITE_OMIT_INCRBLOB
25 /* These functions are implemented in main.c. */
26 extern const char *sqlite3ErrName(int);
29 extern int getDbPointer(Tcl_Interp
*interp
, const char *zA
, sqlite3
**ppDb
);
30 extern void *sqlite3TestTextToPtr(const char *z
);
33 ** Return a pointer to a buffer containing a text representation of the
34 ** pointer passed as the only argument. The original pointer may be extracted
35 ** from the text using sqlite3TestTextToPtr().
37 static char *ptrToText(void *p
){
39 sqlite3_snprintf(sizeof(buf
)-1, buf
, "%p", p
);
44 ** Attempt to extract a blob handle (type sqlite3_blob*) from the Tcl
45 ** object passed as the second argument. If successful, set *ppBlob to
46 ** point to the blob handle and return TCL_OK. Otherwise, store an error
47 ** message in the tcl interpreter and return TCL_ERROR. The final value
48 ** of *ppBlob is undefined in this case.
50 ** If the object contains a string that begins with "incrblob_", then it
51 ** is assumed to be the name of a Tcl channel opened using the [db incrblob]
52 ** command (see tclsqlite.c). Otherwise, it is assumed to be a pointer
53 ** encoded using the ptrToText() routine or similar.
55 static int blobHandleFromObj(
63 z
= Tcl_GetStringFromObj(pObj
, &n
);
66 }else if( n
>9 && 0==memcmp("incrblob_", z
, 9) ){
69 ClientData instanceData
;
71 channel
= Tcl_GetChannel(interp
, z
, ¬Used
);
72 if( !channel
) return TCL_ERROR
;
75 Tcl_Seek(channel
, 0, SEEK_SET
);
77 instanceData
= Tcl_GetChannelInstanceData(channel
);
78 *ppBlob
= *((sqlite3_blob
**)instanceData
);
80 *ppBlob
= (sqlite3_blob
*)sqlite3TestTextToPtr(z
);
87 ** Like Tcl_GetString(), except that if the string is 0 bytes in size, a
88 ** NULL Pointer is returned.
90 static char *blobStringFromObj(Tcl_Obj
*pObj
){
93 z
= Tcl_GetStringFromObj(pObj
, &n
);
98 ** sqlite3_blob_open DB DATABASE TABLE COLUMN ROWID FLAGS VARNAME
100 ** Tcl test harness for the sqlite3_blob_open() function.
102 static int SQLITE_TCLAPI
test_blob_open(
103 ClientData clientData
, /* Not used */
104 Tcl_Interp
*interp
, /* Calling TCL interpreter */
105 int objc
, /* Number of arguments */
106 Tcl_Obj
*CONST objv
[] /* Command arguments */
114 const char *zVarname
;
117 sqlite3_blob
*pBlob
= (sqlite3_blob
*)&flags
; /* Non-zero initialization */
121 const char *zUsage
= "DB DATABASE TABLE COLUMN ROWID FLAGS VARNAME";
122 Tcl_WrongNumArgs(interp
, 1, objv
, zUsage
);
125 if( getDbPointer(interp
, Tcl_GetString(objv
[1]), &db
) ) return TCL_ERROR
;
126 zDb
= Tcl_GetString(objv
[2]);
127 zTable
= blobStringFromObj(objv
[3]);
128 zColumn
= Tcl_GetString(objv
[4]);
129 if( Tcl_GetWideIntFromObj(interp
, objv
[5], &iRowid
) ) return TCL_ERROR
;
130 if( Tcl_GetIntFromObj(interp
, objv
[6], &flags
) ) return TCL_ERROR
;
131 zVarname
= Tcl_GetStringFromObj(objv
[7], &nVarname
);
134 rc
= sqlite3_blob_open(db
, zDb
, zTable
, zColumn
, iRowid
, flags
, &pBlob
);
135 Tcl_SetVar(interp
, zVarname
, ptrToText(pBlob
), 0);
137 rc
= sqlite3_blob_open(db
, zDb
, zTable
, zColumn
, iRowid
, flags
, 0);
141 Tcl_ResetResult(interp
);
143 Tcl_SetResult(interp
, (char*)sqlite3ErrName(rc
), TCL_VOLATILE
);
151 ** sqlite3_blob_close HANDLE
153 static int SQLITE_TCLAPI
test_blob_close(
154 ClientData clientData
, /* Not used */
155 Tcl_Interp
*interp
, /* The TCL interpreter that invoked this command */
156 int objc
, /* Number of arguments */
157 Tcl_Obj
*CONST objv
[] /* Command arguments */
163 Tcl_WrongNumArgs(interp
, 1, objv
, "HANDLE");
167 if( blobHandleFromObj(interp
, objv
[1], &pBlob
) ) return TCL_ERROR
;
168 rc
= sqlite3_blob_close(pBlob
);
171 Tcl_SetResult(interp
, (char*)sqlite3ErrName(rc
), TCL_VOLATILE
);
173 Tcl_ResetResult(interp
);
179 ** sqlite3_blob_bytes HANDLE
181 static int SQLITE_TCLAPI
test_blob_bytes(
182 ClientData clientData
, /* Not used */
183 Tcl_Interp
*interp
, /* The TCL interpreter that invoked this command */
184 int objc
, /* Number of arguments */
185 Tcl_Obj
*CONST objv
[] /* Command arguments */
191 Tcl_WrongNumArgs(interp
, 1, objv
, "HANDLE");
195 if( blobHandleFromObj(interp
, objv
[1], &pBlob
) ) return TCL_ERROR
;
196 nByte
= sqlite3_blob_bytes(pBlob
);
197 Tcl_SetObjResult(interp
, Tcl_NewIntObj(nByte
));
203 ** sqlite3_blob_read CHANNEL OFFSET N
205 ** This command is used to test the sqlite3_blob_read() in ways that
206 ** the Tcl channel interface does not. The first argument should
207 ** be the name of a valid channel created by the [incrblob] method
208 ** of a database handle. This function calls sqlite3_blob_read()
209 ** to read N bytes from offset OFFSET from the underlying SQLite
212 ** On success, a byte-array object containing the read data is
213 ** returned. On failure, the interpreter result is set to the
214 ** text representation of the returned error code (i.e. "SQLITE_NOMEM")
215 ** and a Tcl exception is thrown.
217 static int SQLITE_TCLAPI
test_blob_read(
218 ClientData clientData
, /* Not used */
219 Tcl_Interp
*interp
, /* The TCL interpreter that invoked this command */
220 int objc
, /* Number of arguments */
221 Tcl_Obj
*CONST objv
[] /* Command arguments */
226 unsigned char *zBuf
= 0;
230 Tcl_WrongNumArgs(interp
, 1, objv
, "CHANNEL OFFSET N");
234 if( blobHandleFromObj(interp
, objv
[1], &pBlob
) ) return TCL_ERROR
;
235 if( TCL_OK
!=Tcl_GetIntFromObj(interp
, objv
[2], &iOffset
)
236 || TCL_OK
!=Tcl_GetIntFromObj(interp
, objv
[3], &nByte
)
242 zBuf
= (unsigned char *)Tcl_AttemptAlloc(nByte
);
244 Tcl_AppendResult(interp
, "out of memory in " __FILE__
, 0);
248 rc
= sqlite3_blob_read(pBlob
, zBuf
, nByte
, iOffset
);
250 Tcl_SetObjResult(interp
, Tcl_NewByteArrayObj(zBuf
, nByte
));
252 Tcl_SetResult(interp
, (char *)sqlite3ErrName(rc
), TCL_VOLATILE
);
254 Tcl_Free((char *)zBuf
);
256 return (rc
==SQLITE_OK
? TCL_OK
: TCL_ERROR
);
260 ** sqlite3_blob_write HANDLE OFFSET DATA ?NDATA?
262 ** This command is used to test the sqlite3_blob_write() in ways that
263 ** the Tcl channel interface does not. The first argument should
264 ** be the name of a valid channel created by the [incrblob] method
265 ** of a database handle. This function calls sqlite3_blob_write()
266 ** to write the DATA byte-array to the underlying SQLite blob handle.
269 ** On success, an empty string is returned. On failure, the interpreter
270 ** result is set to the text representation of the returned error code
271 ** (i.e. "SQLITE_NOMEM") and a Tcl exception is thrown.
273 static int SQLITE_TCLAPI
test_blob_write(
274 ClientData clientData
, /* Not used */
275 Tcl_Interp
*interp
, /* The TCL interpreter that invoked this command */
276 int objc
, /* Number of arguments */
277 Tcl_Obj
*CONST objv
[] /* Command arguments */
286 if( objc
!=4 && objc
!=5 ){
287 Tcl_WrongNumArgs(interp
, 1, objv
, "HANDLE OFFSET DATA ?NDATA?");
291 if( blobHandleFromObj(interp
, objv
[1], &pBlob
) ) return TCL_ERROR
;
292 if( TCL_OK
!=Tcl_GetIntFromObj(interp
, objv
[2], &iOffset
) ){
296 zBuf
= Tcl_GetByteArrayFromObj(objv
[3], &nBuf
);
297 if( objc
==5 && Tcl_GetIntFromObj(interp
, objv
[4], &nBuf
) ){
300 rc
= sqlite3_blob_write(pBlob
, zBuf
, nBuf
, iOffset
);
302 Tcl_SetResult(interp
, (char *)sqlite3ErrName(rc
), TCL_VOLATILE
);
305 return (rc
==SQLITE_OK
? TCL_OK
: TCL_ERROR
);
307 #endif /* SQLITE_OMIT_INCRBLOB */
310 ** Register commands with the TCL interpreter.
312 int Sqlitetest_blob_Init(Tcl_Interp
*interp
){
313 #ifndef SQLITE_OMIT_INCRBLOB
316 Tcl_ObjCmdProc
*xProc
;
318 { "sqlite3_blob_open", test_blob_open
},
319 { "sqlite3_blob_close", test_blob_close
},
320 { "sqlite3_blob_bytes", test_blob_bytes
},
321 { "sqlite3_blob_read", test_blob_read
},
322 { "sqlite3_blob_write", test_blob_write
},
325 for(i
=0; i
<sizeof(aObjCmd
)/sizeof(aObjCmd
[0]); i
++){
326 Tcl_CreateObjCommand(interp
, aObjCmd
[i
].zName
, aObjCmd
[i
].xProc
, 0, 0);
328 #endif /* SQLITE_OMIT_INCRBLOB */