X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-sqlite3%2Fsqlite3-sql.lisp;h=90f08120d2895898719235cc85b2e262fc824395;hp=8b433be2ba60b4033d6b18333f6619c32d1e204c;hb=e567409d9fff3f7231c2a0bb69b345e19de2b246;hpb=215ec41559dda52d46539d48a0aa390811c2423c diff --git a/db-sqlite3/sqlite3-sql.lisp b/db-sqlite3/sqlite3-sql.lisp index 8b433be..90f0812 100644 --- a/db-sqlite3/sqlite3-sql.lisp +++ b/db-sqlite3/sqlite3-sql.lisp @@ -31,34 +31,34 @@ (check-connection-spec connection-spec :sqlite3 (name &optional init-foreign-func))) (defmethod database-name-from-spec (connection-spec - (database-type (eql :sqlite3))) + (database-type (eql :sqlite3))) (check-sqlite3-connection-spec connection-spec) (first connection-spec)) (defmethod database-connect (connection-spec (database-type (eql :sqlite3))) (check-sqlite3-connection-spec connection-spec) (handler-case - (let ((db (sqlite3:sqlite3-open (first connection-spec))) - (init-foreign-func (second connection-spec))) - (declare (type sqlite3:sqlite3-db-type db)) - (when init-foreign-func - (handler-case - (funcall init-foreign-func db) - (condition (c) - (progn - (sqlite3:sqlite3-close db) - (error c))))) - (make-instance 'sqlite3-database - :name (database-name-from-spec connection-spec :sqlite3) - :database-type :sqlite3 - :connection-spec connection-spec - :sqlite3-db db)) + (let ((db (sqlite3:sqlite3-open (first connection-spec))) + (init-foreign-func (second connection-spec))) + (declare (type sqlite3:sqlite3-db-type db)) + (when init-foreign-func + (handler-case + (funcall init-foreign-func db) + (condition (c) + (progn + (sqlite3:sqlite3-close db) + (error c))))) + (make-instance 'sqlite3-database + :name (database-name-from-spec connection-spec :sqlite3) + :database-type :sqlite3 + :connection-spec connection-spec + :sqlite3-db db)) (sqlite3:sqlite3-error (err) - (error 'sql-connection-error - :database-type database-type - :connection-spec connection-spec - :error-id (sqlite3:sqlite3-error-code err) - :message (sqlite3:sqlite3-error-message err))))) + (error 'sql-connection-error + :database-type database-type + :connection-spec connection-spec + :error-id (sqlite3:sqlite3-error-code err) + :message (sqlite3:sqlite3-error-message err))))) (defmethod database-disconnect ((database sqlite3-database)) (sqlite3:sqlite3-close (sqlite3-db database)) @@ -68,22 +68,22 @@ (defmethod database-execute-command (sql-expression (database sqlite3-database)) (handler-case (let ((stmt (sqlite3:sqlite3-prepare (sqlite3-db database) sql-expression))) - (declare (type sqlite3:sqlite3-stmt-type stmt)) - (when stmt - (unwind-protect - (sqlite3:sqlite3-step stmt) - (sqlite3:sqlite3-finalize stmt)))) + (declare (type sqlite3:sqlite3-stmt-type stmt)) + (when stmt + (unwind-protect + (sqlite3:sqlite3-step stmt) + (sqlite3:sqlite3-finalize stmt)))) (sqlite3:sqlite3-error (err) (error 'sql-database-data-error - :database database - :expression sql-expression - :error-id (sqlite3:sqlite3-error-code err) - :message (sqlite3:sqlite3-error-message err)))) + :database database + :expression sql-expression + :error-id (sqlite3:sqlite3-error-code err) + :message (sqlite3:sqlite3-error-message err)))) t) (defstruct sqlite3-result-set (stmt sqlite3:null-stmt - :type sqlite3:sqlite3-stmt-type) + :type sqlite3:sqlite3-stmt-type) (n-col 0 :type fixnum) (col-names '()) (result-types '())) @@ -93,137 +93,137 @@ (declare (type sqlite3:sqlite3-stmt-type stmt) (type fixnum n-col)) (if (eq :auto result-types) (loop for n from 0 below n-col - collect (let ((column-type (sqlite3:sqlite3-column-type stmt n))) - (cond - ((= column-type sqlite3:SQLITE-INTEGER) :int64) - ((= column-type sqlite3:SQLITE-FLOAT) :double) - ((= column-type sqlite3:SQLITE-TEXT) :string) - ((= column-type sqlite3:SQLITE-BLOB) :blob) - ((= column-type sqlite3:SQLITE-NULL) :string) - (t :string)))) + collect (let ((column-type (sqlite3:sqlite3-column-type stmt n))) + (cond + ((= column-type sqlite3:SQLITE-INTEGER) :int64) + ((= column-type sqlite3:SQLITE-FLOAT) :double) + ((= column-type sqlite3:SQLITE-TEXT) :string) + ((= column-type sqlite3:SQLITE-BLOB) :blob) + ((= column-type sqlite3:SQLITE-NULL) :string) + (t :string)))) (loop for type in result-types - collect (case type - ((:int :integer :tinyint) :int32) - (:long #+(or x86-64 64bit) :int64 #-(or x86-64 64bit) :int32) - (:bigint :int64) - ((:float :double) :double) - ((:numeric) :number) - (otherwise :string))))) + collect (case type + ((:int :integer :tinyint) :int32) + (:long #+(or x86-64 64bit) :int64 #-(or x86-64 64bit) :int32) + (:bigint :int64) + ((:float :double) :double) + ((:numeric) :number) + (otherwise :string))))) (defmethod database-query-result-set ((query-expression string) - (database sqlite3-database) - &key result-types full-set) + (database sqlite3-database) + &key result-types full-set) (let ((stmt sqlite3:null-stmt)) (declare (type sqlite3:sqlite3-stmt-type stmt)) (handler-case - (progn - (setf stmt (sqlite3:sqlite3-prepare (sqlite3-db database) - query-expression)) - (let* ((n-col (if (sqlite3:sqlite3-step stmt) - ;; Non empty result set. - (sqlite3:sqlite3-column-count stmt) - ;; Empty result set. - 0)) - (result-set (make-sqlite3-result-set - :stmt stmt - :n-col n-col - :col-names (loop for n from 0 below n-col - collect (sqlite3:sqlite3-column-name stmt n)) - :result-types (when (> n-col 0) - (get-result-types stmt n-col result-types))))) - (if full-set - (values result-set n-col nil) - (values result-set n-col)))) + (progn + (setf stmt (sqlite3:sqlite3-prepare (sqlite3-db database) + query-expression)) + (let* ((n-col (if (sqlite3:sqlite3-step stmt) + ;; Non empty result set. + (sqlite3:sqlite3-column-count stmt) + ;; Empty result set. + 0)) + (result-set (make-sqlite3-result-set + :stmt stmt + :n-col n-col + :col-names (loop for n from 0 below n-col + collect (sqlite3:sqlite3-column-name stmt n)) + :result-types (when (> n-col 0) + (get-result-types stmt n-col result-types))))) + (if full-set + (values result-set n-col nil) + (values result-set n-col)))) (sqlite3:sqlite3-error (err) - (progn - (unless (eq stmt sqlite3:null-stmt) - (ignore-errors - (sqlite3:sqlite3-finalize stmt))) - (error 'sql-database-data-error - :database database - :expression query-expression - :error-id (sqlite3:sqlite3-error-code err) - :message (sqlite3:sqlite3-error-message err))))))) + (progn + (unless (eq stmt sqlite3:null-stmt) + (ignore-errors + (sqlite3:sqlite3-finalize stmt))) + (error 'sql-database-data-error + :database database + :expression query-expression + :error-id (sqlite3:sqlite3-error-code err) + :message (sqlite3:sqlite3-error-message err))))))) (defmethod database-dump-result-set (result-set (database sqlite3-database)) - (handler-case + (handler-case (sqlite3:sqlite3-finalize (sqlite3-result-set-stmt result-set)) (sqlite3:sqlite3-error (err) (error 'sql-database-error - :message - (format nil "Error finalizing SQLite3 statement: ~A" - (sqlite3:sqlite3-error-message err)))))) + :message + (format nil "Error finalizing SQLite3 statement: ~A" + (sqlite3:sqlite3-error-message err)))))) (defmethod database-store-next-row (result-set (database sqlite3-database) list) (let ((n-col (sqlite3-result-set-n-col result-set))) (if (= n-col 0) - ;; empty result set. - nil - ;; Non-empty set. - (let ((stmt (sqlite3-result-set-stmt result-set))) - (declare (type sqlite3:sqlite3-stmt-type stmt)) - ;; Store row in list. - (loop for i = 0 then (1+ i) - for rest on list - for types = (sqlite3-result-set-result-types result-set) then (rest types) - do (setf (car rest) - (if (eq (first types) :blob) - (clsql-uffi:convert-raw-field - (sqlite3:sqlite3-column-blob stmt i) - types 0 - (sqlite3:sqlite3-column-bytes stmt i)) - (clsql-uffi:convert-raw-field - (sqlite3:sqlite3-column-text stmt i) - types 0)))) - ;; Advance result set cursor. - (handler-case - (unless (sqlite3:sqlite3-step stmt) - (setf (sqlite3-result-set-n-col result-set) 0)) - (sqlite3:sqlite3-error (err) - (error 'sql-database-error - :message (format nil "Error in sqlite3-step: ~A" + ;; empty result set. + nil + ;; Non-empty set. + (let ((stmt (sqlite3-result-set-stmt result-set))) + (declare (type sqlite3:sqlite3-stmt-type stmt)) + ;; Store row in list. + (loop for i = 0 then (1+ i) + for rest on list + for types = (sqlite3-result-set-result-types result-set) then (rest types) + do (setf (car rest) + (if (eq (first types) :blob) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-blob stmt i) + types 0 + (sqlite3:sqlite3-column-bytes stmt i)) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-text stmt i) + types 0)))) + ;; Advance result set cursor. + (handler-case + (unless (sqlite3:sqlite3-step stmt) + (setf (sqlite3-result-set-n-col result-set) 0)) + (sqlite3:sqlite3-error (err) + (error 'sql-database-error + :message (format nil "Error in sqlite3-step: ~A" (sqlite3:sqlite3-error-message err))))) - t)))) + t)))) (defmethod database-query (query-expression (database sqlite3-database) result-types field-names) (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) (handler-case - (let ((stmt (sqlite3:sqlite3-prepare (sqlite3-db database) - query-expression)) - (rows '()) - (col-names '())) - (declare (type sqlite3:sqlite3-stmt-type stmt)) - (unwind-protect - (when (sqlite3:sqlite3-step stmt) - (let ((n-col (sqlite3:sqlite3-column-count stmt))) - (flet ((extract-row-data () - (loop for i from 0 below n-col - for types = (get-result-types stmt n-col result-types) then (rest types) - collect (if (eq (first types) :blob) - (clsql-uffi:convert-raw-field - (sqlite3:sqlite3-column-blob stmt i) - types 0 - (sqlite3:sqlite3-column-bytes stmt i)) - (clsql-uffi:convert-raw-field - (sqlite3:sqlite3-column-text stmt i) - types 0))))) - (when field-names - (setf col-names (loop for n from 0 below n-col - collect (sqlite3:sqlite3-column-name stmt n)))) - (push (extract-row-data) rows) - (do* () (nil) - (if (sqlite3:sqlite3-step stmt) - (push (extract-row-data) rows) - (return)))))) - (sqlite3:sqlite3-finalize stmt)) - (values (nreverse rows) col-names)) + (let ((stmt (sqlite3:sqlite3-prepare (sqlite3-db database) + query-expression)) + (rows '()) + (col-names '())) + (declare (type sqlite3:sqlite3-stmt-type stmt)) + (unwind-protect + (when (sqlite3:sqlite3-step stmt) + (let ((n-col (sqlite3:sqlite3-column-count stmt))) + (flet ((extract-row-data () + (loop for i from 0 below n-col + for types = (get-result-types stmt n-col result-types) then (rest types) + collect (if (eq (first types) :blob) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-blob stmt i) + types 0 + (sqlite3:sqlite3-column-bytes stmt i)) + (clsql-uffi:convert-raw-field + (sqlite3:sqlite3-column-text stmt i) + types 0))))) + (when field-names + (setf col-names (loop for n from 0 below n-col + collect (sqlite3:sqlite3-column-name stmt n)))) + (push (extract-row-data) rows) + (do* () (nil) + (if (sqlite3:sqlite3-step stmt) + (push (extract-row-data) rows) + (return)))))) + (sqlite3:sqlite3-finalize stmt)) + (values (nreverse rows) col-names)) (sqlite3:sqlite3-error (err) (error 'sql-database-data-error - :database database - :expression query-expression - :error-id (sqlite3:sqlite3-error-code err) - :message (sqlite3:sqlite3-error-message err))))) + :database database + :expression query-expression + :error-id (sqlite3:sqlite3-error-code err) + :message (sqlite3:sqlite3-error-message err))))) ;;; Object listing @@ -231,14 +231,14 @@ (declare (ignore owner)) ;; Query is copied from .table command of sqlite3 command line utility. (mapcar #'car (database-query - "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name" - database nil nil))) + "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name" + database nil nil))) (defmethod database-list-tables ((database sqlite3-database) &key owner) (remove-if #'(lambda (s) (and (>= (length s) 11) (string-equal (subseq s 0 11) "_CLSQL_SEQ_"))) - (database-list-tables-and-sequences database :owner owner))) + (database-list-tables-and-sequences database :owner owner))) (defmethod database-list-views ((database sqlite3-database) &key (owner nil)) @@ -255,49 +255,49 @@ database nil nil))) (defmethod database-list-table-indexes (table (database sqlite3-database) - &key (owner nil)) + &key (owner nil)) (declare (ignore owner)) (let ((*print-circle* nil)) - (mapcar #'car - (database-query - (format - nil - "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name" - table table) - database nil nil)))) + (mapcar #'car + (database-query + (format + nil + "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='~A' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' AND tbl_name='~A' ORDER BY name" + table table) + database nil nil)))) (declaim (inline sqlite3-table-info)) (defun sqlite3-table-info (table database) (database-query (format nil "PRAGMA table_info('~A')" table) - database nil nil)) + database nil nil)) (defmethod database-list-attributes (table (database sqlite3-database) &key (owner nil)) (declare (ignore owner)) (mapcar #'(lambda (table-info) (second table-info)) - (sqlite3-table-info table database))) + (sqlite3-table-info table database))) -(defmethod database-attribute-type (attribute table - (database sqlite3-database) +(defmethod database-attribute-type (attribute table + (database sqlite3-database) &key (owner nil)) (declare (ignore owner)) (loop for field-info in (sqlite3-table-info table database) when (string= attribute (second field-info)) - return - (let* ((raw-type (third field-info)) - (start-length (position #\( raw-type)) - (type (if start-length - (subseq raw-type 0 start-length) - raw-type)) - (length (if start-length - (parse-integer (subseq raw-type (1+ start-length)) - :junk-allowed t) - nil))) - (values (when type (ensure-keyword type)) - length - nil - (if (string-equal (fourth field-info) "0") - 1 0))))) + return + (let* ((raw-type (third field-info)) + (start-length (position #\( raw-type)) + (type (if start-length + (subseq raw-type 0 start-length) + raw-type)) + (length (if start-length + (parse-integer (subseq raw-type (1+ start-length)) + :junk-allowed t) + nil))) + (values (when type (ensure-keyword type)) + length + nil + (if (string-equal (fourth field-info) "0") + 1 0))))) (defmethod database-create (connection-spec (type (eql :sqlite3))) (declare (ignore connection-spec)) @@ -307,14 +307,14 @@ (defmethod database-destroy (connection-spec (type (eql :sqlite3))) (destructuring-bind (name) connection-spec (if (probe-file name) - (delete-file name) - nil))) + (delete-file name) + nil))) (defmethod database-probe (connection-spec (type (eql :sqlite3))) (destructuring-bind (name) connection-spec ;; TODO: Add a test that this file is a real sqlite3 database (or (string-equal ":memory:" name) - (and (probe-file name) t)))) + (and (probe-file name) t)))) ;;; Database capabilities