From b4261c1f3730d8973bfc5207d4e49c910bd64b16 Mon Sep 17 00:00:00 2001 From: Kiyoshi Mizumaru Date: Mon, 26 Mar 2012 02:49:18 +0900 Subject: [PATCH 1/7] modified to use the same letter case for error-code symbols and run-all-tests function. --- sqlite.asd | 2 +- sqlite.lisp | 18 +++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/sqlite.asd b/sqlite.asd index 0e50873..0b85ba8 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 "run-all-tests" :sqlite-tests))) diff --git a/sqlite.lisp b/sqlite.lisp index de0f97d..2125fb7 100644 --- a/sqlite.lisp +++ b/sqlite.lisp @@ -53,7 +53,7 @@ statement (db-handle (if statement (db statement))) (sql-text (if statement (sql statement)))) - (error (if (eq error-code :constraint) + (error (if (eq error-code :CONSTRAINT) 'sqlite-constraint-error 'sqlite-error) :format-control (if (listp message) (first message) message) @@ -91,7 +91,7 @@ (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))) - (if (eq error-code :ok) + (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))))) @@ -120,7 +120,7 @@ (for statement in statements) (really-finalize-statement statement)) (let ((error-code (sqlite-ffi:sqlite3-close (handle handle)))) - (unless (eq error-code :ok) + (unless (eq error-code :OK) (sqlite-error error-code "Could not close sqlite3 database." :db-handle handle)) (slot-makunbound handle 'handle))) @@ -139,7 +139,7 @@ (cffi:with-foreign-object (p-tail '(:pointer :char)) (cffi:with-foreign-string (sql (sql object)) (let ((error-code (sqlite-ffi:sqlite3-prepare (handle (db object)) sql -1 p-statement p-tail))) - (unless (eq error-code :ok) + (unless (eq error-code :OK) (sqlite-error error-code "Could not prepare an sqlite statement." :db-handle (db object) :sql-text (sql object))) (unless (zerop (cffi:mem-ref (cffi:mem-ref p-tail '(:pointer :char)) :uchar)) @@ -190,21 +190,21 @@ Note: does not immediately release resources because statements are cached." Returns T is successfully advanced to the next row and NIL if there are no more rows." (let ((error-code (sqlite-ffi:sqlite3-step (handle statement)))) (case error-code - (:done nil) - (:row t) + (:DONE nil) + (:ROW t) (t (sqlite-error error-code "Error while stepping an sqlite statement." :statement statement))))) (defun reset-statement (statement) "Resets the STATEMENT and prepare it to be called again." (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement)))) - (unless (eq error-code :ok) + (unless (eq error-code :OK) (sqlite-error error-code "Error while resetting an sqlite statement." :statement statement)))) (defun clear-statement-bindings (statement) "Sets all binding values to NULL." (let ((error-code (sqlite-ffi:sqlite3-clear-bindings (handle statement)))) - (unless (eq error-code :ok) + (unless (eq error-code :OK) (sqlite-error error-code "Error while clearing bindings of an sqlite statement." :statement statement)))) @@ -398,7 +398,7 @@ Supported types: (list "Do not know how to pass value ~A of type ~A to sqlite." value (type-of value)) :statement statement))))) - (unless (eq error-code :ok) + (unless (eq error-code :OK) (sqlite-error error-code (list "Error when binding parameter ~A to value ~A." parameter value) :statement statement))))) From 6875d2175f8119608b6e904aab3237375c05c90c Mon Sep 17 00:00:00 2001 From: Kiyoshi Mizumaru Date: Fri, 30 Mar 2012 14:43:57 +0900 Subject: [PATCH 2/7] modified to work with Allegro CL's modern case mode. --- sqlite.asd | 5 ++++- sqlite.lisp | 23 +++++++++++++---------- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/sqlite.asd b/sqlite.asd index 0b85ba8..7cbfe53 100644 --- a/sqlite.asd +++ b/sqlite.asd @@ -10,4 +10,7 @@ :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 #-allegro (intern "RUN-ALL-TESTS" :sqlite-tests) + #+allegro (if (eq excl:*current-case-mode* :case-sensitive-lower) + (intern "run-all-tests" :sqlite-tests) + (intern "RUN-ALL-TESTS")))) diff --git a/sqlite.lisp b/sqlite.lisp index 2125fb7..7b45175 100644 --- a/sqlite.lisp +++ b/sqlite.lisp @@ -231,8 +231,8 @@ Returns: result))))) (defmacro with-prepared-statement (statement-var (db sql parameters-var) &body body) - (let ((i-var (gensym "I")) - (value-var (gensym "VALUE"))) + (let ((i-var (gensym #-allegro "I" #+allegro "i")) + (value-var (gensym #-allegro "VALUE" #+allegro "value"))) `(let ((,statement-var (prepare-statement ,db ,sql))) (unwind-protect (progn @@ -244,8 +244,8 @@ Returns: (finalize-statement ,statement-var))))) (defmacro with-prepared-statement/named (statement-var (db sql parameters-var) &body body) - (let ((name-var (gensym "NAME")) - (value-var (gensym "VALUE"))) + (let ((name-var (gensym #-allegro "NAME" #+allegro "name")) + (value-var (gensym #-allegro "VALUE" #+allegro "value"))) `(let ((,statement-var (prepare-statement ,db ,sql))) (unwind-protect (progn @@ -460,8 +460,9 @@ 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) - (let ((statement (gensym "STATEMENT-")) +(defmacro-driver #-allegro (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters) + #+allegro (for vars in-sqlite-query query-expression on-database db &optional with-parameters parameters) + (let ((statement (gensym #-allegro "STATEMENT-" #+allegro "statement-")) (kwd (if generate 'generate 'for))) `(progn (with ,statement = (prepare-statement ,db ,query-expression)) (finally-protected (when ,statement (finalize-statement ,statement))) @@ -477,8 +478,9 @@ 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) - (let ((statement (gensym "STATEMENT-")) +(defmacro-driver #-allegro (FOR vars IN-SQLITE-QUERY/NAMED query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters) + #+allegro (for vars in-sqlite-query/named query-expression on-database db &optional with-parameters parameters) + (let ((statement (gensym #-allegro "STATEMENT-" #+allegro "statement-")) (kwd (if generate 'generate 'for))) `(progn (with ,statement = (prepare-statement ,db ,query-expression)) (finally-protected (when ,statement (finalize-statement ,statement))) @@ -494,8 +496,9 @@ See BIND-PARAMETER for the list of supported parameter types." (terminate))))))) -(defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement) - (let ((statement-var (gensym "STATEMENT-")) +(defmacro-driver #-allegro (FOR vars ON-SQLITE-STATEMENT statement) + #+allegro (for vars on-sqlite-statement statement) + (let ((statement-var (gensym #-allegro "STATEMENT" #+allegro "statement-")) (kwd (if generate 'generate 'for))) `(progn (with ,statement-var = ,statement) (,kwd ,(if (symbolp vars) From 80959cb6d02fc998caf4816f285ba33d612927a1 Mon Sep 17 00:00:00 2001 From: Kiyoshi Mizumaru Date: Sat, 31 Mar 2012 23:26:22 +0900 Subject: [PATCH 3/7] Revert "modified to work with Allegro CL's modern case mode." This reverts commit 6875d2175f8119608b6e904aab3237375c05c90c. --- sqlite.asd | 5 +---- sqlite.lisp | 23 ++++++++++------------- 2 files changed, 11 insertions(+), 17 deletions(-) diff --git a/sqlite.asd b/sqlite.asd index 7cbfe53..0b85ba8 100644 --- a/sqlite.asd +++ b/sqlite.asd @@ -10,7 +10,4 @@ :in-order-to ((test-op (load-op sqlite-tests)))) (defmethod perform ((o asdf:test-op) (c (eql (find-system :sqlite)))) - (funcall #-allegro (intern "RUN-ALL-TESTS" :sqlite-tests) - #+allegro (if (eq excl:*current-case-mode* :case-sensitive-lower) - (intern "run-all-tests" :sqlite-tests) - (intern "RUN-ALL-TESTS")))) + (funcall (intern "run-all-tests" :sqlite-tests))) diff --git a/sqlite.lisp b/sqlite.lisp index 7b45175..2125fb7 100644 --- a/sqlite.lisp +++ b/sqlite.lisp @@ -231,8 +231,8 @@ Returns: result))))) (defmacro with-prepared-statement (statement-var (db sql parameters-var) &body body) - (let ((i-var (gensym #-allegro "I" #+allegro "i")) - (value-var (gensym #-allegro "VALUE" #+allegro "value"))) + (let ((i-var (gensym "I")) + (value-var (gensym "VALUE"))) `(let ((,statement-var (prepare-statement ,db ,sql))) (unwind-protect (progn @@ -244,8 +244,8 @@ Returns: (finalize-statement ,statement-var))))) (defmacro with-prepared-statement/named (statement-var (db sql parameters-var) &body body) - (let ((name-var (gensym #-allegro "NAME" #+allegro "name")) - (value-var (gensym #-allegro "VALUE" #+allegro "value"))) + (let ((name-var (gensym "NAME")) + (value-var (gensym "VALUE"))) `(let ((,statement-var (prepare-statement ,db ,sql))) (unwind-protect (progn @@ -460,9 +460,8 @@ See BIND-PARAMETER for the list of supported parameter types." (progn ,@body) (disconnect ,db)))) -(defmacro-driver #-allegro (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters) - #+allegro (for vars in-sqlite-query query-expression on-database db &optional with-parameters parameters) - (let ((statement (gensym #-allegro "STATEMENT-" #+allegro "statement-")) +(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)) (finally-protected (when ,statement (finalize-statement ,statement))) @@ -478,9 +477,8 @@ See BIND-PARAMETER for the list of supported parameter types." (collect `(statement-column-value ,statement ,i)))) (terminate))))))) -(defmacro-driver #-allegro (FOR vars IN-SQLITE-QUERY/NAMED query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters) - #+allegro (for vars in-sqlite-query/named query-expression on-database db &optional with-parameters parameters) - (let ((statement (gensym #-allegro "STATEMENT-" #+allegro "statement-")) +(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)) (finally-protected (when ,statement (finalize-statement ,statement))) @@ -496,9 +494,8 @@ See BIND-PARAMETER for the list of supported parameter types." (terminate))))))) -(defmacro-driver #-allegro (FOR vars ON-SQLITE-STATEMENT statement) - #+allegro (for vars on-sqlite-statement statement) - (let ((statement-var (gensym #-allegro "STATEMENT" #+allegro "statement-")) +(defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement) + (let ((statement-var (gensym "STATEMENT-")) (kwd (if generate 'generate 'for))) `(progn (with ,statement-var = ,statement) (,kwd ,(if (symbolp vars) From 306e9b22a42a08d14520fd8ccb23d01da87dd65c Mon Sep 17 00:00:00 2001 From: Kiyoshi Mizumaru Date: Sat, 31 Mar 2012 23:30:29 +0900 Subject: [PATCH 4/7] Revert "modified to use the same letter case for error-code symbols and run-all-tests function." This reverts commit b4261c1f3730d8973bfc5207d4e49c910bd64b16. --- sqlite.asd | 2 +- sqlite.lisp | 18 +++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/sqlite.asd b/sqlite.asd index 0b85ba8..0e50873 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 "RUN-ALL-TESTS" :sqlite-tests))) diff --git a/sqlite.lisp b/sqlite.lisp index 2125fb7..de0f97d 100644 --- a/sqlite.lisp +++ b/sqlite.lisp @@ -53,7 +53,7 @@ statement (db-handle (if statement (db statement))) (sql-text (if statement (sql statement)))) - (error (if (eq error-code :CONSTRAINT) + (error (if (eq error-code :constraint) 'sqlite-constraint-error 'sqlite-error) :format-control (if (listp message) (first message) message) @@ -91,7 +91,7 @@ (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))) - (if (eq error-code :OK) + (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))))) @@ -120,7 +120,7 @@ (for statement in statements) (really-finalize-statement statement)) (let ((error-code (sqlite-ffi:sqlite3-close (handle handle)))) - (unless (eq error-code :OK) + (unless (eq error-code :ok) (sqlite-error error-code "Could not close sqlite3 database." :db-handle handle)) (slot-makunbound handle 'handle))) @@ -139,7 +139,7 @@ (cffi:with-foreign-object (p-tail '(:pointer :char)) (cffi:with-foreign-string (sql (sql object)) (let ((error-code (sqlite-ffi:sqlite3-prepare (handle (db object)) sql -1 p-statement p-tail))) - (unless (eq error-code :OK) + (unless (eq error-code :ok) (sqlite-error error-code "Could not prepare an sqlite statement." :db-handle (db object) :sql-text (sql object))) (unless (zerop (cffi:mem-ref (cffi:mem-ref p-tail '(:pointer :char)) :uchar)) @@ -190,21 +190,21 @@ Note: does not immediately release resources because statements are cached." Returns T is successfully advanced to the next row and NIL if there are no more rows." (let ((error-code (sqlite-ffi:sqlite3-step (handle statement)))) (case error-code - (:DONE nil) - (:ROW t) + (:done nil) + (:row t) (t (sqlite-error error-code "Error while stepping an sqlite statement." :statement statement))))) (defun reset-statement (statement) "Resets the STATEMENT and prepare it to be called again." (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement)))) - (unless (eq error-code :OK) + (unless (eq error-code :ok) (sqlite-error error-code "Error while resetting an sqlite statement." :statement statement)))) (defun clear-statement-bindings (statement) "Sets all binding values to NULL." (let ((error-code (sqlite-ffi:sqlite3-clear-bindings (handle statement)))) - (unless (eq error-code :OK) + (unless (eq error-code :ok) (sqlite-error error-code "Error while clearing bindings of an sqlite statement." :statement statement)))) @@ -398,7 +398,7 @@ Supported types: (list "Do not know how to pass value ~A of type ~A to sqlite." value (type-of value)) :statement statement))))) - (unless (eq error-code :OK) + (unless (eq error-code :ok) (sqlite-error error-code (list "Error when binding parameter ~A to value ~A." parameter value) :statement statement))))) From fa4fad2466a2eed7e4e17a363489e8bf17704fcb Mon Sep 17 00:00:00 2001 From: Kiyoshi Mizumaru Date: Sun, 1 Apr 2012 12:19:54 +0900 Subject: [PATCH 5/7] modified to work with Allegro CL's modern case mode. --- sqlite-ffi.lisp | 58 ++++++++++++++++++++++++------------------------- sqlite.asd | 2 +- sqlite.lisp | 8 +++---- 3 files changed, 34 insertions(+), 34 deletions(-) diff --git a/sqlite-ffi.lisp b/sqlite-ffi.lisp index 09964f7..93292bd 100644 --- a/sqlite-ffi.lisp +++ b/sqlite-ffi.lisp @@ -42,35 +42,35 @@ (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) 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..45bc8f3 100644 --- a/sqlite.lisp +++ b/sqlite.lisp @@ -71,7 +71,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" @@ -460,7 +460,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 +477,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 +494,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) From 42d75e4274c31d059e2f19f47020230fcf495fa4 Mon Sep 17 00:00:00 2001 From: Marco Baringer Date: Mon, 5 Nov 2012 09:47:41 +0100 Subject: [PATCH 6/7] Added ability to connect to db with flags via sqlite_open_v2 call --- sqlite-ffi.lisp | 37 +++++++++++++++++++++++++++++++++++++ sqlite.lisp | 38 +++++++++++++++++++++++++++++++------- 2 files changed, 68 insertions(+), 7 deletions(-) diff --git a/sqlite-ffi.lisp b/sqlite-ffi.lisp index 09964f7..1e7cb8e 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 @@ -76,10 +78,39 @@ (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.lisp b/sqlite.lisp index de0f97d..586d25f 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 @@ -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)) @@ -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))))))) From 5c62e80b0657797d562607ab6f10e63a3121f110 Mon Sep 17 00:00:00 2001 From: Marco Baringer Date: Mon, 5 Nov 2012 10:19:13 +0100 Subject: [PATCH 7/7] Downcase open flag constants --- sqlite-ffi.lisp | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/sqlite-ffi.lisp b/sqlite-ffi.lisp index cd52a4a..692d677 100644 --- a/sqlite-ffi.lisp +++ b/sqlite-ffi.lisp @@ -79,26 +79,26 @@ (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 */ + (: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