master 5d032f2904: Allow inserting and selecting binary blobs from sqlite

[Lars Ingebrigtsen]

branch: master
commit 5d032f2904d4604110e24eb3ae0daf8f7701d72f
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Allow inserting and selecting binary blobs from sqlite
    
    * doc/lispref/text.texi (Database): Document how to insert binary
    data.
    * src/sqlite.c (bind_values): Bind BLOB columns correctly (bug#54591).
---
 doc/lispref/text.texi    | 18 ++++++++++++++++++
 src/sqlite.c             | 49 +++++++++++++++++++++++++++++++++++++++---------
 test/src/sqlite-tests.el | 25 ++++++++++++++++++++++++
 3 files changed, 83 insertions(+), 9 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index ca6a483c54..a1db715db6 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5309,6 +5309,24 @@ interpolation).
 @code{sqlite-execute} returns the number of affected rows.  For
 instance, an @samp{insert} statement will return @samp{1}, whereas an
 @samp{update} statement may return zero or a higher number.
+
+Strings in SQLite are, by default, stored as @code{utf-8}, and
+selecting a text column will decode the string using that charset.
+Selecting a blob column will return the raw data without any decoding
+(i.e., it will return a unibyte string containing the bytes as stored
+in the database).  Inserting binary data into blob columns, however,
+requires some care, as @code{sqlite-execute} will, by default,
+interpret all strings as @code{utf-8}.
+
+So if you have, for instance, @acronym{GIF} data in a unibyte string
+called @var{gif}, you have to mark it specially to let
+@code{sqlite-execute} know this:
+
+@lisp
+(put-text-property 0 1 'coding-system 'binary gif)
+(sqlite-execute db "insert into foo values (?, ?)" (list gif 2))
+@end lisp
+
 @end defun
 
 @defun sqlite-select db query &optional values result-type
diff --git a/src/sqlite.c b/src/sqlite.c
index 7388b576e9..75a3b2ea32 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -43,6 +43,8 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2,
 DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*));
 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text,
            (sqlite3_stmt*, int, const char*, int, void(*)(void*)));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_blob,
+           (sqlite3_stmt*, int, const char*, int, void(*)(void*)));
 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
            (sqlite3_stmt*, int, sqlite3_int64));
 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double));
@@ -80,6 +82,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
 # undef sqlite3_open_v2
 # undef sqlite3_reset
 # undef sqlite3_bind_text
+# undef sqlite3_bind_blob
 # undef sqlite3_bind_int64
 # undef sqlite3_bind_double
 # undef sqlite3_bind_null
@@ -103,6 +106,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
 # define sqlite3_open_v2 fn_sqlite3_open_v2
 # define sqlite3_reset fn_sqlite3_reset
 # define sqlite3_bind_text fn_sqlite3_bind_text
+# define sqlite3_bind_blob fn_sqlite3_bind_blob
 # define sqlite3_bind_int64 fn_sqlite3_bind_int64
 # define sqlite3_bind_double fn_sqlite3_bind_double
 # define sqlite3_bind_null fn_sqlite3_bind_null
@@ -129,6 +133,7 @@ load_dll_functions (HMODULE library)
   LOAD_DLL_FN (library, sqlite3_open_v2);
   LOAD_DLL_FN (library, sqlite3_reset);
   LOAD_DLL_FN (library, sqlite3_bind_text);
+  LOAD_DLL_FN (library, sqlite3_bind_blob);
   LOAD_DLL_FN (library, sqlite3_bind_int64);
   LOAD_DLL_FN (library, sqlite3_bind_double);
   LOAD_DLL_FN (library, sqlite3_bind_null);
@@ -309,10 +314,37 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object 
values)
 
       if (EQ (type, Qstring))
        {
-         Lisp_Object encoded = encode_string (value);
-         ret = sqlite3_bind_text (stmt, i + 1,
-                                  SSDATA (encoded), SBYTES (encoded),
-                                  NULL);
+         Lisp_Object encoded;
+         bool blob = false;
+
+         if (SBYTES (value) == 0)
+           encoded = value;
+         else
+           {
+             Lisp_Object coding_system =
+               Fget_text_property (make_fixnum (0), Qcoding_system, value);
+             if (NILP (coding_system))
+               /* Default to utf-8.  */
+               encoded = encode_string (value);
+             else if (EQ (coding_system, Qbinary))
+               blob = true;
+             else
+               encoded = Fencode_coding_string (value, coding_system,
+                                                Qnil, Qnil);
+           }
+
+         if (blob)
+           {
+             if (SBYTES (value) != SCHARS (value))
+               xsignal1 (Qerror, build_string ("BLOB values must be unibyte"));
+           ret = sqlite3_bind_blob (stmt, i + 1,
+                                      SSDATA (value), SBYTES (value),
+                                      NULL);
+           }
+           else
+             ret = sqlite3_bind_text (stmt, i + 1,
+                                      SSDATA (encoded), SBYTES (encoded),
+                                      NULL);
        }
       else if (EQ (type, Qinteger))
        {
@@ -426,11 +458,8 @@ row_to_value (sqlite3_stmt *stmt)
          break;
 
        case SQLITE_BLOB:
-         v =
-           code_convert_string_norecord
-           (make_unibyte_string (sqlite3_column_blob (stmt, i),
-                                 sqlite3_column_bytes (stmt, i)),
-            Qutf_8, false);
+         v = make_unibyte_string (sqlite3_column_blob (stmt, i),
+                                  sqlite3_column_bytes (stmt, i));
          break;
 
        case SQLITE_NULL:
@@ -748,4 +777,6 @@ syms_of_sqlite (void)
   DEFSYM (Qfalse, "false");
   DEFSYM (Qsqlite, "sqlite");
   DEFSYM (Qsqlite3, "sqlite3");
+  DEFSYM (Qbinary, "binary");
+  DEFSYM (Qcoding_system, "coding-system");
 }
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
index 6e44300f3a..5af4392301 100644
--- a/test/src/sqlite-tests.el
+++ b/test/src/sqlite-tests.el
@@ -216,4 +216,29 @@
        db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so")
       '(nil t)))))
 
+(ert-deftest sqlite-blob ()
+  (skip-unless (sqlite-available-p))
+  (let (db)
+    (progn
+      (setq db (sqlite-open))
+      (sqlite-execute
+       db "create table if not exists test10 (col1 text, col2 blob, col3 
numbre)")
+      (let ((string (with-temp-buffer
+                      (set-buffer-multibyte nil)
+                      (insert 0 1 2)
+                      (buffer-string))))
+        (should-not (multibyte-string-p string))
+        (sqlite-execute
+         db "insert into test10 values (?, ?, 1)"
+         (list string
+               (propertize string
+                           'coding-system 'binary)))
+        (cl-destructuring-bind
+            (c1 c2 _)
+            (car (sqlite-select db "select * from test10 where col3 = 1"))
+          (should (equal c1 string))
+          (should (equal c2 string))
+          (should (multibyte-string-p c1))
+          (should-not (multibyte-string-p c2)))))))
+
 ;;; sqlite-tests.el ends here