SQLiteBlob.mod 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201
  1. MODULE SQLiteBlob;
  2. (* BLOB storage and access:
  3. bind_blob, bind_zeroblob, column_blob, column_bytes,
  4. incremental blob_open/read/write/bytes/reopen/close. *)
  5. FROM SYSTEM IMPORT ADDRESS, ADR;
  6. FROM SQLite IMPORT
  7. SQLiteOk, SQLiteRow, SQLiteDone, SQLiteBlob,
  8. SQLiteBlobReadOnly, SQLiteBlobReadWrite,
  9. SQLiteOpenReadWrite, SQLiteOpenCreate, SQLiteOpenMemory,
  10. sqlite3_open_v2, sqlite3_exec, sqlite3_close_v2,
  11. sqlite3_prepare_v2, sqlite3_bind_blob, sqlite3_bind_zeroblob,
  12. sqlite3_step, sqlite3_reset, sqlite3_clear_bindings,
  13. sqlite3_column_type, sqlite3_column_bytes, sqlite3_column_blob,
  14. sqlite3_finalize,
  15. sqlite3_changes, sqlite3_total_changes, sqlite3_last_insert_rowid,
  16. sqlite3_blob_open, sqlite3_blob_close, sqlite3_blob_read,
  17. sqlite3_blob_write, sqlite3_blob_bytes, sqlite3_blob_reopen,
  18. sqlite3_free, SQLiteTransient;
  19. VAR
  20. ExitCode : INTEGER;
  21. db, stmt, blob, p : ADDRESS;
  22. bin, out : ARRAY [0..7] OF CHAR;
  23. rc : INTEGER;
  24. ok : BOOLEAN;
  25. PROCEDURE ExecSQL (sql : ARRAY OF CHAR) : BOOLEAN;
  26. VAR
  27. errmsg : ADDRESS;
  28. good : BOOLEAN;
  29. BEGIN
  30. errmsg := NIL;
  31. good := sqlite3_exec(db, sql, NIL, NIL, errmsg) = SQLiteOk;
  32. IF errmsg # NIL THEN
  33. sqlite3_free(errmsg)
  34. END;
  35. RETURN good
  36. END ExecSQL;
  37. PROCEDURE SameBytes (a, b : ARRAY OF CHAR; n : INTEGER) : BOOLEAN;
  38. VAR
  39. i : INTEGER;
  40. BEGIN
  41. i := 0;
  42. WHILE (i < n) AND (a[i] = b[i]) DO
  43. i := i + 1
  44. END;
  45. RETURN i = n
  46. END SameBytes;
  47. PROCEDURE FinishStmt;
  48. BEGIN
  49. IF stmt # NIL THEN
  50. IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END;
  51. stmt := NIL
  52. END
  53. END FinishStmt;
  54. BEGIN
  55. ExitCode := 1;
  56. db := NIL; stmt := NIL; blob := NIL; p := NIL;
  57. ok := FALSE;
  58. bin[0] := CHR(0); bin[1] := CHR(1); bin[2] := CHR(2);
  59. bin[3] := CHR(0); bin[4] := CHR(255);
  60. IF (sqlite3_open_v2(":memory:", db,
  61. SQLiteOpenReadWrite + SQLiteOpenCreate + SQLiteOpenMemory,
  62. NIL) = SQLiteOk) AND (db # NIL) THEN
  63. IF ExecSQL("CREATE TABLE b(id INTEGER PRIMARY KEY, data BLOB);") THEN
  64. rc := sqlite3_prepare_v2(db,
  65. "INSERT INTO b(data) VALUES (?);", -1, stmt, NIL);
  66. ok := (rc = SQLiteOk) AND (stmt # NIL);
  67. (* 5-byte binary value, including an embedded NUL. ADR(bin[0])
  68. skips the V3 array descriptor and passes the first data byte. *)
  69. IF ok THEN
  70. ok := sqlite3_bind_blob(stmt, 1, ADR(bin[0]), 5,
  71. SQLiteTransient()) = SQLiteOk
  72. END;
  73. IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
  74. IF ok THEN ok := sqlite3_reset(stmt) = SQLiteOk END;
  75. IF ok THEN ok := sqlite3_clear_bindings(stmt) = SQLiteOk END;
  76. (* Legitimate zero-length BLOB, distinct from NULL. *)
  77. IF ok THEN
  78. ok := sqlite3_bind_blob(stmt, 1, ADR(bin[0]), 0,
  79. SQLiteTransient()) = SQLiteOk
  80. END;
  81. IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
  82. IF ok THEN ok := sqlite3_reset(stmt) = SQLiteOk END;
  83. IF ok THEN ok := sqlite3_clear_bindings(stmt) = SQLiteOk END;
  84. (* Eight zero bytes for incremental BLOB I/O. *)
  85. IF ok THEN ok := sqlite3_bind_zeroblob(stmt, 1, 8) = SQLiteOk END;
  86. IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
  87. FinishStmt;
  88. IF ok THEN
  89. ok := (sqlite3_changes(db) = 1)
  90. AND (sqlite3_total_changes(db) = 3)
  91. AND (sqlite3_last_insert_rowid(db) = 3)
  92. END
  93. END
  94. END;
  95. (* Read the binary BLOB column metadata. *)
  96. IF ok THEN
  97. rc := sqlite3_prepare_v2(db,
  98. "SELECT data FROM b WHERE id = 1;", -1, stmt, NIL);
  99. ok := (rc = SQLiteOk) AND (stmt # NIL);
  100. IF ok THEN
  101. ok := sqlite3_step(stmt) = SQLiteRow;
  102. IF ok THEN
  103. ok := (sqlite3_column_type(stmt, 0) = SQLiteBlob)
  104. AND (sqlite3_column_bytes(stmt, 0) = 5);
  105. p := sqlite3_column_blob(stmt, 0);
  106. IF p = NIL THEN ok := FALSE END;
  107. IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
  108. END
  109. END;
  110. FinishStmt
  111. END;
  112. (* Verify the bound bytes through a read-only incremental BLOB. *)
  113. IF ok THEN
  114. rc := sqlite3_blob_open(db, "main", "b", "data", 1,
  115. SQLiteBlobReadOnly, blob);
  116. ok := (rc = SQLiteOk) AND (blob # NIL)
  117. END;
  118. IF ok THEN ok := sqlite3_blob_bytes(blob) = 5 END;
  119. IF ok THEN
  120. ok := sqlite3_blob_read(blob, ADR(out[0]), 5, 0) = SQLiteOk
  121. END;
  122. IF ok THEN ok := SameBytes(bin, out, 5) END;
  123. IF blob # NIL THEN
  124. IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END;
  125. blob := NIL
  126. END;
  127. (* A zero-length BLOB reports SQLiteBlob with zero bytes. *)
  128. IF ok THEN
  129. rc := sqlite3_prepare_v2(db,
  130. "SELECT data FROM b WHERE id = 2;", -1, stmt, NIL);
  131. ok := (rc = SQLiteOk) AND (stmt # NIL);
  132. IF ok THEN
  133. ok := sqlite3_step(stmt) = SQLiteRow;
  134. IF ok THEN
  135. ok := (sqlite3_column_type(stmt, 0) = SQLiteBlob)
  136. AND (sqlite3_column_bytes(stmt, 0) = 0);
  137. IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
  138. END
  139. END;
  140. FinishStmt
  141. END;
  142. (* Incremental BLOB I/O on the zeroblob row. *)
  143. IF ok THEN
  144. rc := sqlite3_blob_open(db, "main", "b", "data", 3,
  145. SQLiteBlobReadWrite, blob);
  146. ok := (rc = SQLiteOk) AND (blob # NIL)
  147. END;
  148. IF ok THEN ok := sqlite3_blob_bytes(blob) = 8 END;
  149. IF ok THEN
  150. ok := sqlite3_blob_write(blob, ADR(bin[0]), 5, 0) = SQLiteOk
  151. END;
  152. IF ok THEN
  153. ok := sqlite3_blob_read(blob, ADR(out[0]), 5, 0) = SQLiteOk
  154. END;
  155. IF ok THEN ok := SameBytes(bin, out, 5) END;
  156. IF ok THEN ok := sqlite3_blob_reopen(blob, 3) = SQLiteOk END;
  157. IF blob # NIL THEN
  158. IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END;
  159. blob := NIL
  160. END;
  161. (* The write survives closing the incremental BLOB handle. *)
  162. IF ok THEN
  163. rc := sqlite3_prepare_v2(db,
  164. "SELECT data FROM b WHERE id = 3;", -1, stmt, NIL);
  165. ok := (rc = SQLiteOk) AND (stmt # NIL);
  166. IF ok THEN
  167. ok := sqlite3_step(stmt) = SQLiteRow;
  168. IF ok THEN
  169. ok := (sqlite3_column_type(stmt, 0) = SQLiteBlob)
  170. AND (sqlite3_column_bytes(stmt, 0) = 8);
  171. IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
  172. END
  173. END;
  174. FinishStmt
  175. END;
  176. FinishStmt;
  177. IF blob # NIL THEN
  178. IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END
  179. END;
  180. IF db # NIL THEN
  181. IF sqlite3_close_v2(db) # SQLiteOk THEN ok := FALSE END
  182. END;
  183. IF ok THEN ExitCode := 42 END
  184. END SQLiteBlob.