X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-sqlite%2Fsqlite-sql.lisp;h=17e8ff81dbf70dfac2a521060abcccf224f4b1e1;hp=d07be2a5f13e3814c22694d23d003ebf3476003d;hb=e622ee6f4bf2b9fe81af59d566e651c983a4833b;hpb=7cdc9aa48baa3c52923d61da6fa632eb47ac0b5d diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index d07be2a..17e8ff8 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -45,11 +45,11 @@ :connection-spec connection-spec :sqlite-db (sqlite:sqlite-open (first connection-spec))) (sqlite:sqlite-error (err) - (error 'clsql-connect-error + (error 'sql-connection-error :database-type database-type :connection-spec connection-spec - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err))))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))))) (defmethod database-disconnect ((database sqlite-database)) (sqlite:sqlite-close (sqlite-db database)) @@ -62,16 +62,16 @@ (sqlite:sqlite-get-table (sqlite-db database) sql-expression) (sqlite:sqlite-free-table data) (unless (= row-n 0) - (error 'clsql-simple-warning + (error 'sql-warning :format-control "Result set not empty: ~@(~A~) row~:P, ~@(~A~) column~:P " :format-arguments (list row-n col-n)))) (sqlite:sqlite-error (err) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err)))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err)))) t) (defstruct sqlite-result-set @@ -105,11 +105,11 @@ (values (nreverse rows) col-names)) (push new-row rows))) (sqlite:sqlite-error (err) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err))))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))))) (defmethod database-query-result-set ((query-expression string) (database sqlite-database) @@ -134,11 +134,11 @@ (values result-set n-col nil) (values result-set n-col))))) (sqlite:sqlite-error (err) - (error 'clsql-sql-error + (error 'sql-database-error :database database :expression query-expression - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err))))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))))) (defun canonicalize-result-types (result-types n-col col-names) (when result-types @@ -150,7 +150,7 @@ collect (case type ((:int :integer :tinyint :long :bigint) - :integer) + :int32) ((:float :double) :double) ((:numeric) @@ -162,9 +162,10 @@ (handler-case (sqlite:sqlite-finalize (sqlite-result-set-vm result-set)) (sqlite:sqlite-error (err) - (error 'clsql-simple-error - :format-control "Error finalizing SQLite VM: ~A" - :format-arguments (list (sqlite:sqlite-error-message err)))))) + (error 'sql-database-error + :message + (format nil "Error finalizing SQLite VM: ~A" + (sqlite:sqlite-error-message err)))))) (defmethod database-store-next-row (result-set (database sqlite-database) list) (let ((n-col (sqlite-result-set-n-col result-set)) @@ -184,17 +185,24 @@ (return-from database-store-next-row nil) (setf row new-row))) (sqlite:sqlite-error (err) - (error 'clsql-simple-error - :format-control "Error in sqlite-step: ~A" - :format-arguments - (list (sqlite:sqlite-error-message err))))) + (error 'sql-database-error + :message + (format nil "Error in sqlite-step: ~A" + (sqlite:sqlite-error-message err))))) - ;; Use the row previously read by database-query-result-set. + ;; Use the row previously read by database-query-result-set. (setf (sqlite-result-set-first-row result-set) (sqlite:make-null-row))) (loop for i = 0 then (1+ i) for rest on list do (setf (car rest) + #-clisp + (clsql-uffi:convert-raw-field + (uffi:deref-array + (uffi:deref-pointer row 'sqlite:sqlite-row-pointer) '(:array (* :unsigned-char)) i) + result-types + i) + #+clisp (let ((type (if result-types (nth i result-types) :string)) @@ -209,22 +217,25 @@ (:double (when val (coerce - (read-from-string (sqlite:sqlite-aref row i)) + (read-from-string val) 'double-float))))))) (sqlite:sqlite-free-row row) t)))) ;;; Object listing -(defmethod database-list-tables ((database sqlite-database) &key owner) +(defmethod database-list-tables-and-sequences ((database sqlite-database) &key owner) (declare (ignore owner)) ;; Query is copied from .table command of sqlite comamnd 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))) + +(defmethod database-list-tables ((database sqlite-database) &key owner) (remove-if #'(lambda (s) (and (>= (length s) 11) (string-equal (subseq s 0 11) "_CLSQL_SEQ_"))) - (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)))) + (database-list-tables-and-sequences database :owner owner))) (defmethod database-list-views ((database sqlite-database) &key (owner nil)) @@ -285,81 +296,6 @@ (if (string-equal (fourth field-info) "0") 1 0))))) -(defun %sequence-name-to-table-name (sequence-name) - (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name))) - -(defun %table-name-to-sequence-name (table-name) - (and (>= (length table-name) 11) - (string= (subseq table-name 0 11) "_CLSQL_SEQ_") - (subseq table-name 11))) - - -(defmethod database-create-sequence (sequence-name - (database sqlite-database)) - (let ((table-name (%sequence-name-to-table-name sequence-name))) - (database-execute-command - (concatenate 'string "CREATE TABLE " table-name - " (last_value integer PRIMARY KEY, increment_by integer, min_value integer, is_called char(1))") - database) - (database-execute-command - (concatenate 'string "INSERT INTO " table-name - " VALUES (1,1,1,'f')") - database))) - -(defmethod database-drop-sequence (sequence-name - (database sqlite-database)) - (database-execute-command - (concatenate 'string "DROP TABLE " (%sequence-name-to-table-name sequence-name)) - database)) - -(defmethod database-list-sequences ((database sqlite-database) - &key (owner nil)) - (declare (ignore owner)) - (mapcan #'(lambda (s) - (let ((sn (%table-name-to-sequence-name (car s)))) - (and sn (list sn)))) - (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))) - -(defmethod database-sequence-next (sequence-name (database sqlite-database)) - (without-interrupts - (let* ((table-name (%sequence-name-to-table-name sequence-name)) - (tuple - (car (database-query - (concatenate 'string "SELECT last_value,is_called FROM " - table-name) - database :auto nil)))) - (cond - ((char-equal (schar (second tuple) 0) #\f) - (database-execute-command - (format nil "UPDATE ~A SET is_called='t'" table-name) - database) - (car tuple)) - (t - (let ((new-pos (1+ (car tuple)))) - (database-execute-command - (format nil "UPDATE ~A SET last_value=~D" table-name new-pos) - database) - new-pos)))))) - -(defmethod database-sequence-last (sequence-name (database sqlite-database)) - (without-interrupts - (caar (database-query - (concatenate 'string "SELECT last_value FROM " - (%sequence-name-to-table-name sequence-name)) - database :auto nil)))) - -(defmethod database-set-sequence-position (sequence-name - (position integer) - (database sqlite-database)) - (database-execute-command - (format nil "UPDATE ~A SET last_value=~A,is_called='t'" - (%sequence-name-to-table-name sequence-name) - position) - database) - position) - (defmethod database-create (connection-spec (type (eql :sqlite))) (declare (ignore connection-spec)) ;; databases are created automatically by SQLite