use sqlite_open_v2 when we have open flags

sqlite-ffi.lisp

@@ -3,6 +3,8 @@
   (:export :error-code
            :p-sqlite3
            :sqlite3-open
+           :sqlite3-open-v2
+           :sqlite3-open-flag
            :sqlite3-close
            :sqlite3-errmsg
            :sqlite3-busy-timeout
@@ -42,44 +44,73 @@
 (use-foreign-library sqlite3-lib)
 
 (defcenum error-code
-  (:OK 0)
-  (:ERROR 1)
-  (:INTERNAL 2)
-  (:PERM 3)
-  (:ABORT 4)
-  (:BUSY 5)
-  (:LOCKED 6)
-  (:NOMEM 7)
-  (:READONLY 8)
-  (:INTERRUPT 9)
-  (:IOERR 10)
-  (:CORRUPT 11)
-  (:NOTFOUND 12)
-  (:FULL 13)
-  (:CANTOPEN 14)
-  (:PROTOCOL 15)
-  (:EMPTY 16)
-  (:SCHEMA 17)
-  (:TOOBIG 18)
-  (:CONSTRAINT 19)
-  (:MISMATCH 20)
-  (:MISUSE 21)
-  (:NOLFS 22)
-  (:AUTH 23)
-  (:FORMAT 24)
-  (:RANGE 25)
-  (:NOTADB 26)
-  (:ROW 100)
-  (:DONE 101))
+  (:ok 0)
+  (:error 1)
+  (:internal 2)
+  (:perm 3)
+  (:abort 4)
+  (:busy 5)
+  (:locked 6)
+  (:nomem 7)
+  (:readonly 8)
+  (:interrupt 9)
+  (:ioerr 10)
+  (:corrupt 11)
+  (:notfound 12)
+  (:full 13)
+  (:cantopen 14)
+  (:protocol 15)
+  (:empty 16)
+  (:schema 17)
+  (:toobig 18)
+  (:constraint 19)
+  (:mismatch 20)
+  (:misuse 21)
+  (:nolfs 22)
+  (:auth 23)
+  (:format 24)
+  (:range 25)
+  (:notadb 26)
+  (:row 100)
+  (:done 101))
 
 (defcstruct sqlite3)
 
 (defctype p-sqlite3 (:pointer sqlite3))
 
+(defcenum sqlite3-open-flag
+  (:readonly         #x00001)         ; /* Ok for sqlite3_open_v2() */
+  (:readwrite        #x00002)         ; /* Ok for sqlite3_open_v2() */
+  (:create           #x00004)         ; /* Ok for sqlite3_open_v2() */
+  (:deleteonclose    #x00008)         ; /* VFS only */
+  (:exclusive        #x00010)         ; /* VFS only */
+  (:autoproxy        #x00020)         ; /* VFS only */
+  (:uri              #x00040)         ; /* Ok for sqlite3_open_v2() */
+  (:memory           #x00080)         ; /* Ok for sqlite3_open_v2() */
+  (:main_db          #x00100)         ; /* VFS only */
+  (:temp_db          #x00200)         ; /* VFS only */
+  (:transient_db     #x00400)         ; /* VFS only */
+  (:main_journal     #x00800)         ; /* VFS only */
+  (:temp_journal     #x01000)         ; /* VFS only */
+  (:subjournal       #x02000)         ; /* VFS only */
+  (:master_journal   #x04000)         ; /* VFS only */
+  (:nomutex          #x08000)         ; /* Ok for sqlite3_open_v2() */
+  (:fullmutex        #x10000)         ; /* Ok for sqlite3_open_v2() */
+  (:sharedcache      #x20000)         ; /* Ok for sqlite3_open_v2() */
+  (:privatecache     #x40000)         ; /* Ok for sqlite3_open_v2() */
+  (:wal              #x80000)         ; /* VFS only */
+  )
+
 (defcfun sqlite3-open error-code
   (filename :string)
   (db (:pointer p-sqlite3)))
 
+(defcfun sqlite3-open-v2 error-code
+  (filename :string)
+  (db (:pointer p-sqlite3))
+  (flags :int)
+  (zVfs :string))
+
 (defcfun sqlite3-close error-code
   (db p-sqlite3))
 
@@ -190,6 +221,12 @@
   (bytes-count :int)
   (destructor :pointer))
 
+(defcfun sqlite3-libversion :string)
+
+(defcfun sqlite3-sourceid :string)
+
+(defcfun sqlite3-libversion-number :int)
+
 (defconstant destructor-transient-address (mod -1 (expt 2 (* 8 (cffi:foreign-type-size :pointer)))))
 
 (defun destructor-transient () (cffi:make-pointer destructor-transient-address))

sqlite.asd

@@ -10,4 +10,4 @@
   :in-order-to ((test-op (load-op sqlite-tests))))
 
 (defmethod perform ((o asdf:test-op) (c (eql (find-system :sqlite))))
-  (funcall (intern "RUN-ALL-TESTS" :sqlite-tests)))
+  (funcall (intern (symbol-name '#:run-all-tests) :sqlite-tests)))

sqlite.lisp

@@ -7,6 +7,7 @@
            :sqlite-error-message
            :sqlite-error-sql
            :sqlite-handle
+           :sqlite-v2-handle
            :connect
            :set-busy-timeout
            :disconnect
@@ -71,7 +72,7 @@
                    (not (eq (sqlite-error-code obj) :ok)))
               (sqlite-error-message obj))
       (format stream "~&Code ~A: ~A."
-              (or (sqlite-error-code obj) :OK)
+              (or (sqlite-error-code obj) :ok)
               (or (sqlite-error-message obj) "no message")))
     (when (sqlite-error-db-handle obj)
       (format stream "~&Database: ~A"
@@ -88,22 +89,45 @@
    (statements :initform nil :accessor sqlite-handle-statements))
   (:documentation "Class that encapsulates the connection to the database. Use connect and disconnect."))
 
+(defclass sqlite-v2-handle (sqlite-handle)
+  ((open-flags :initarg :open-flags :accessor open-flags :initform (list :readwrite :create))
+   (vfs :accessor vfs :initform nil))
+  (:documentation "Just like sqlite-handle but uses the sqlite_open_v2
+interface to connect. This allows a readonly connection (or a
+connectien without sqlite_open_create)."))
+
+(defgeneric sqlite-handle-open (handle database-path db-pointer)
+  (:documentation "A wrapper around sqlite-ffi:sqlite3-open(-v2)."))
+
+(defmethod sqlite-handle-open ((handle sqlite-handle) database-path db-pointer)
+  (sqlite-ffi:sqlite3-open database-path db-pointer))
+
+(defmethod sqlite-handle-open ((handle sqlite-v2-handle) database-path db-pointer)
+  (sqlite-ffi:sqlite3-open-v2 database-path db-pointer
+                              (reduce #'logior
+                                      (mapcar (lambda (flag)
+                                                (cffi:foreign-enum-value 'sqlite-ffi:sqlite3-open-flag flag))
+                                              (open-flags handle)))
+                              (cffi:null-pointer)))
+
 (defmethod initialize-instance :after ((object sqlite-handle) &key (database-path ":memory:") &allow-other-keys)
   (cffi:with-foreign-object (ppdb 'sqlite-ffi:p-sqlite3)
-    (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb)))
+    (let ((error-code (sqlite-handle-open object database-path ppdb)))
       (if (eq error-code :ok)
           (setf (handle object) (cffi:mem-ref ppdb 'sqlite-ffi:p-sqlite3)
                 (database-path object) database-path)
           (sqlite-error error-code (list "Could not open sqlite3 database ~A" database-path)))))
   (setf (cache object) (make-instance 'sqlite.cache:mru-cache :cache-size 16 :destructor #'really-finalize-statement)))
 
-(defun connect (database-path &key busy-timeout)
+(defun connect (database-path &key busy-timeout flags)
   "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect.
    Operations will wait for locked databases for up to BUSY-TIMEOUT milliseconds; if BUSY-TIMEOUT is NIL, then operations on locked databases will fail immediately."
-  (let ((db (make-instance 'sqlite-handle
-                           :database-path (etypecase database-path
-                                            (string database-path)
-                                            (pathname (namestring database-path))))))
+  (let* ((database-path (etypecase database-path
+                                     (string database-path)
+                                     (pathname (namestring database-path))))
+         (db (if flags
+                 (make-instance 'sqlite-v2-handle :database-path database-path :flags flags)
+                 (make-instance 'sqlite-handle :database-path database-path))))
     (when busy-timeout
       (set-busy-timeout db busy-timeout))
     db))
@@ -460,7 +484,7 @@ See BIND-PARAMETER for the list of supported parameter types."
           (progn ,@body)
        (disconnect ,db))))
 
-(defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters)
+(defmacro-driver (for vars in-sqlite-query query-expression on-database db &optional with-parameters parameters)
   (let ((statement (gensym "STATEMENT-"))
         (kwd (if generate 'generate 'for)))
     `(progn (with ,statement = (prepare-statement ,db ,query-expression))
@@ -477,7 +501,7 @@ See BIND-PARAMETER for the list of supported parameter types."
                                                   (collect `(statement-column-value ,statement ,i))))
                                   (terminate)))))))
 
-(defmacro-driver (FOR vars IN-SQLITE-QUERY/NAMED query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters)
+(defmacro-driver (for vars in-sqlite-query/named query-expression on-database db &optional with-parameters parameters)
   (let ((statement (gensym "STATEMENT-"))
         (kwd (if generate 'generate 'for)))
     `(progn (with ,statement = (prepare-statement ,db ,query-expression))
@@ -494,7 +518,7 @@ See BIND-PARAMETER for the list of supported parameter types."
                                   (terminate)))))))
 
 
-(defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement)
+(defmacro-driver (for vars on-sqlite-statement statement)
   (let ((statement-var (gensym "STATEMENT-"))
         (kwd (if generate 'generate 'for)))
     `(progn (with ,statement-var = ,statement)
@@ -504,4 +528,4 @@ See BIND-PARAMETER for the list of supported parameter types."
                   next (progn (if (step-statement ,statement-var)
                                   (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
                                                   (collect `(statement-column-value ,statement-var ,i))))
-                                  (terminate)))))))
+                                  (terminate)))))))