diff --git a/sqlite-ffi.lisp b/sqlite-ffi.lisp index 09964f7..692d677 100644 --- a/sqlite-ffi.lisp +++ b/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)) diff --git a/sqlite.asd b/sqlite.asd index 0e50873..1faccf9 100644 --- a/sqlite.asd +++ b/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))) diff --git a/sqlite.lisp b/sqlite.lisp index de0f97d..f2b7713 100644 --- a/sqlite.lisp +++ b/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))))))) \ No newline at end of file + (terminate)))))))