X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-sqlite%2Fsqlite-sql.lisp;h=3c6d31ea7e70d46e44e7e912c98afdfa706d29eb;hp=befc8850e497b850a7a579923b9f679ac480034a;hb=5148be446aee32ec705beac3fbba35f499df4fd4;hpb=e7359cb3f285d3a53b768b13484caf11bc6f47b1 diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index befc885..3c6d31e 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)) @@ -67,11 +67,11 @@ "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 @@ -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,12 +185,12 @@ (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) @@ -198,7 +199,7 @@ #-clisp (clsql-uffi:convert-raw-field (uffi:deref-array - (uffi:deref-pointer row 'sqlite:sqlite-row-pointer) '(:array (* :char)) i) + (uffi:deref-pointer row 'sqlite:sqlite-row-pointer) '(:array (* :unsigned-char)) i) result-types i) #+clisp @@ -223,15 +224,18 @@ ;;; 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)) @@ -292,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