X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-sqlite%2Fsqlite-sql.lisp;h=be6ff906ac54ea7728dc810123da3cbd6542afd3;hb=2b89a1b56dfb8c1cdfaae36b2d4ff7382cff8b40;hp=3c6d31ea7e70d46e44e7e912c98afdfa706d29eb;hpb=5148be446aee32ec705beac3fbba35f499df4fd4;p=clsql.git diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 3c6d31e..be6ff90 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -62,7 +62,7 @@ (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)))) @@ -76,34 +76,50 @@ (defstruct sqlite-result-set (vm (sqlite:make-null-vm) - #-clisp :type - #-clisp sqlite:sqlite-vm-pointer) + :type sqlite:sqlite-vm-pointer) (first-row (sqlite:make-null-row) - #-clisp :type - #-clisp sqlite:sqlite-row-pointer-type) + :type sqlite:sqlite-row-pointer-type) (col-names (sqlite:make-null-row) - #-clisp :type - #-clisp sqlite:sqlite-row-pointer-type) + :type sqlite:sqlite-row-pointer-type) (result-types nil) (n-col 0 :type fixnum)) (defmethod database-query (query-expression (database sqlite-database) result-types field-names) (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) (handler-case - (multiple-value-bind (result-set n-col) - (database-query-result-set query-expression database - :result-types result-types - :full-set nil) - (do* ((rows nil) - (col-names (when field-names - (loop for j from 0 below n-col - collect (sqlite:sqlite-aref (sqlite-result-set-col-names result-set) j)))) - (new-row (make-list n-col) (make-list n-col)) - (row-ok (database-store-next-row result-set database new-row) - (database-store-next-row result-set database new-row))) - ((not row-ok) - (values (nreverse rows) col-names)) - (push new-row rows))) + (let ((vm (sqlite:sqlite-compile (sqlite-db database) + query-expression)) + (rows '()) + (col-names '())) + (unwind-protect + ;; Read the first row to get column number and names. + (multiple-value-bind (n-col new-row sqlite-col-names) + (sqlite:sqlite-step vm) + (declare (type sqlite:sqlite-row-pointer-type new-row)) + (when (> n-col 0) + (when field-names + (setf col-names (loop for i from 0 below n-col + collect (sqlite:sqlite-aref sqlite-col-names i)))) + (let ((canonicalized-result-types + (canonicalize-result-types result-types n-col sqlite-col-names))) + (flet ((extract-row-data (row) + (declare (type sqlite:sqlite-row-pointer-type row)) + (loop for i from 0 below n-col + collect (clsql-uffi:convert-raw-field + (sqlite:sqlite-raw-aref row i) + canonicalized-result-types i)))) + (push (extract-row-data new-row) rows) + + ;; Read subsequent rows. + (do () (nil) + (multiple-value-bind (n-col new-row) + (sqlite:sqlite-step vm) + (declare (type sqlite:sqlite-row-pointer-type new-row)) + (if (> n-col 0) + (push (extract-row-data new-row) rows) + (return)))))))) + (sqlite:sqlite-finalize vm)) + (values (nreverse rows) col-names)) (sqlite:sqlite-error (err) (error 'sql-database-data-error :database database @@ -114,43 +130,55 @@ (defmethod database-query-result-set ((query-expression string) (database sqlite-database) &key result-types full-set) - (handler-case - (let ((vm (sqlite:sqlite-compile (sqlite-db database) - query-expression))) - ;;; To obtain column number/datatypes we have to read the first row. - (multiple-value-bind (n-col cols col-names) - (sqlite:sqlite-step vm) - (let ((result-set (make-sqlite-result-set - :vm vm - :first-row cols - :n-col n-col - :col-names col-names - :result-types - (canonicalize-result-types - result-types - n-col - col-names)))) - (if full-set - (values result-set n-col nil) - (values result-set n-col))))) - (sqlite:sqlite-error (err) - (error 'sql-database-error - :database database - :expression query-expression - :error-id (sqlite:sqlite-error-code err) - :message (sqlite:sqlite-error-message err))))) + (let ((vm nil)) + (handler-case + (progn + (setf vm (sqlite:sqlite-compile (sqlite-db database) + query-expression)) + ;;; To obtain column number/datatypes we have to read the first row. + (multiple-value-bind (n-col cols col-names) + (sqlite:sqlite-step vm) + (declare (type sqlite:sqlite-row-pointer-type cols)) + (let ((result-set (make-sqlite-result-set + :vm vm + :first-row cols + :n-col n-col + :col-names col-names + :result-types + (canonicalize-result-types + result-types + n-col + col-names)))) + (if full-set + (values result-set n-col nil) + (values result-set n-col))))) + (sqlite:sqlite-error (err) + (progn + (when vm + ;; The condition was thrown by sqlite-step, vm must be + ;; deallocated. + (ignore-errors + (sqlite:sqlite-finalize vm))) + (error 'sql-database-data-error + :database database + :expression query-expression + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))11))))) (defun canonicalize-result-types (result-types n-col col-names) (when result-types (let ((raw-types (if (eq :auto result-types) (loop for j from n-col below (* 2 n-col) collect (ensure-keyword (sqlite:sqlite-aref col-names j))) - result-types))) + result-types))) (loop for type in raw-types collect (case type - ((:int :integer :tinyint :long :bigint) + ((:int :integer :tinyint) :int32) + (:long #+(or x86-64 64bit) :int64 #-(or x86-64 64bit) :int32) + (:bigint + :int64) ((:float :double) :double) ((:numeric) @@ -180,7 +208,7 @@ (multiple-value-bind (n new-row col-names) (sqlite:sqlite-step (sqlite-result-set-vm result-set)) (declare (ignore n col-names) - #-clisp (type sqlite:sqlite-row-pointer-type new-row)) + (type sqlite:sqlite-row-pointer-type new-row)) (if (sqlite:null-row-p new-row) (return-from database-store-next-row nil) (setf row new-row))) @@ -196,29 +224,10 @@ (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) + (sqlite:sqlite-raw-aref row i) result-types - i) - #+clisp - (let ((type (if result-types - (nth i result-types) - :string)) - (val (sqlite:sqlite-aref row i))) - (case type - (:string - val) - (:integer - (when val (parse-integer val))) - (:number - (read-from-string val)) - (:double - (when val - (coerce - (read-from-string val) - 'double-float))))))) + i))) (sqlite:sqlite-free-row row) t))))