diff --git a/src/dbd/mysql.lisp b/src/dbd/mysql.lisp index dcf87f4..99fb671 100644 --- a/src/dbd/mysql.lisp +++ b/src/dbd/mysql.lisp @@ -56,25 +56,31 @@ (setf (mysql-use-store query) store) query)) -(defun result-set-field-names (handle) - (mapcar (lambda (field) - ;; field = (name column-type) - (intern (first field) :keyword)) - (first (result-set-fields handle)))) - -(defun fetch-next-row (handle &optional fields) - (let ((row (next-row handle)) - (fields (or fields - (result-set-field-names handle)))) - (when row - (loop for field in fields - for value in row - append (list field value))))) - -(defun fetch-all-rows (handle) - (loop with fields = (result-set-field-names handle) +(defun fetch-next-row (handle &key (fields (first (result-set-fields handle))) + format) + (let ((format (or format :plist)) + (row (next-row handle))) + (etypecase format + (:plist + (loop for field in fields + for value in row + append (list (intern field :keyword) value))) + (:alist + (mapcar #'cons fields row)) + (:values row) + (:hash-table + (let ((hash (make-hash-table :test 'equal))) + (loop for field in fields + for value in row + do (setf (gethash field hash) value)) + hash))))) + +(defun fetch-all-rows (handle &key format) + (loop with fields = (first (result-set-fields handle)) for count from 0 - for row = (fetch-next-row handle fields) + for row = (fetch-next-row handle + :fields fields + :format format) while row collect row into rows finally (return (values rows @@ -83,7 +89,7 @@ ;; Return the modified count for modification query. (first (process-result-set handle (make-hash-table)))))))) -(defmethod execute-using-connection ((conn dbd-mysql-connection) (query dbd-mysql-query) params) +(defmethod execute-using-connection ((conn dbd-mysql-connection) (query dbd-mysql-query) params &optional format) (let* (took-usec (result (with-error-handler conn @@ -96,12 +102,14 @@ (cond ((mysql-use-store query) (multiple-value-bind (rows count) - (fetch-all-rows result) + (fetch-all-rows result :format format) (sql-log (query-sql query) params count took-usec) (setf result (make-mysql-result-list rows count)) (setf (query-row-count query) count))) (t (sql-log (query-sql query) params nil took-usec))) + (when format + (setf (query-row-format query) format)) (setf (query-results query) result) query)) @@ -109,7 +117,8 @@ (let ((result (query-results query))) (if (mysql-result-list-p result) (pop (slot-value result 'result-set)) - (fetch-next-row result)))) + (fetch-next-row result + :format (query-row-format query))))) (defmethod escape-sql ((conn dbd-mysql-connection) (sql string)) (escape-string sql :database (connection-handle conn))) diff --git a/src/dbd/postgres.lisp b/src/dbd/postgres.lisp index 987d413..2fdfbbc 100644 --- a/src/dbd/postgres.lisp +++ b/src/dbd/postgres.lisp @@ -114,10 +114,24 @@ (not (query-freed-p query))) (push name (slot-value conn '%deallocation-queue))))))))) -(defmethod execute-using-connection ((conn dbd-postgres-connection) (query dbd-postgres-query) params) +(def-row-reader plist-row-reader (fields) + (loop while (next-row) + collect (loop for field across fields + collect (intern (field-name field) :keyword) + collect (next-field field)))) + +(def-row-reader hash-row-reader (fields) + (let ((hash (make-hash-table :test 'equal))) + (loop while (next-row) + do (loop for field across fields + do (setf (gethash field hash) + (next-field field)))) + hash)) + +(defmethod execute-using-connection ((conn dbd-postgres-connection) (query dbd-postgres-query) params &optional format) (with-handling-pg-errors (let (took-usec retried) - (multiple-value-bind (result count) + (multiple-value-bind (rows count) (with-took-usec took-usec (block nil (tagbody retry @@ -126,14 +140,11 @@ (slot-value query 'name) params ;; TODO: lazy fetching - (row-reader (fields) - (let ((result - (loop while (next-row) - collect (loop for field across fields - collect (intern (field-name field) :keyword) - collect (next-field field))))) - (setf (query-results query) result) - query)))) + (etypecase format + (:plist 'plist-row-reader) + (:alist 'alist-row-reader) + (:hash-table 'hash-row-reader) + (:values 'list-row-reader)))) (invalid-sql-statement-name (e) ;; Retry if cached prepared statement is not available anymore (when (and (query-cached-p query) @@ -146,14 +157,19 @@ (go retry)) (error e)))))) (sql-log (query-sql query) params count took-usec) - (or result - (progn - (setf (slot-value conn '%modified-row-count) count) - (make-instance 'dbd-postgres-query - :connection conn - :sql (query-sql query) - :results (list count) - :row-count count))))))) + (when format + (setf (query-row-format query) format)) + (cond + (rows + (setf (query-results query) rows) + query) + (t + (setf (slot-value conn '%modified-row-count) count) + (make-instance 'dbd-postgres-query + :connection conn + :sql (query-sql query) + :results (list count) + :row-count count))))))) (defmethod fetch ((query dbd-postgres-query)) (pop (query-results query))) diff --git a/src/dbd/sqlite3.lisp b/src/dbd/sqlite3.lisp index 3817e52..068fd98 100644 --- a/src/dbd/sqlite3.lisp +++ b/src/dbd/sqlite3.lisp @@ -55,13 +55,15 @@ :error-code (sqlite-error-code e))))))) query)) -(defmethod execute-using-connection ((conn dbd-sqlite3-connection) (query dbd-sqlite3-query) params) +(defmethod execute-using-connection ((conn dbd-sqlite3-connection) (query dbd-sqlite3-query) params &optional format) (let ((prepared (query-prepared query))) (reset-statement prepared) (let ((count 0)) (dolist (param params) (bind-parameter prepared (incf count) param))) (slot-makunbound query 'dbi.driver::results) + (when format + (setf (query-row-format query) format)) (cond ((sqlite3-use-store query) (setf (query-results query) @@ -104,10 +106,26 @@ (declare (ignore e)) (finalize-statement prepared) nil)) - (loop for column in (statement-column-names prepared) - for i from 0 - append (list (intern column :keyword) - (statement-column-value prepared i))))))) + (etypecase (query-row-format query) + (:plist + (loop for column in (statement-column-names prepared) + for i from 0 + collect (intern column :keyword) + collect (statement-column-value prepared i))) + (:alist + (loop for column in (statement-column-names prepared) + for i from 0 + collect (cons column (statement-column-value prepared i)))) + (:hash-table + (let ((hash (make-hash-table :test 'equal))) + (loop for column in (statement-column-names prepared) + for i from 0 + do (setf (gethash column hash) + (statement-column-value prepared i))) + hash)) + (:values + (loop for i from 0 + collect (statement-column-value prepared i)))))))) (defmethod disconnect ((conn dbd-sqlite3-connection)) (when (slot-boundp (connection-handle conn) 'sqlite::handle) diff --git a/src/driver.lisp b/src/driver.lisp index 75aa346..a5bb225 100644 --- a/src/driver.lisp +++ b/src/driver.lisp @@ -24,6 +24,7 @@ #:query-prepared #:query-results #:query-row-count + #:query-row-format #:query-cached-p #:prepare #:prepare-cached @@ -128,6 +129,10 @@ Driver should be named like 'DBD-SOMETHING' for a database 'something'." :initarg :row-count :initform nil :accessor query-row-count) + (row-format :type (member :plist :alist :hash-table :values) + :initarg :row-format + :initform :plist + :accessor query-row-format) (cached :initarg :cached :initform nil :accessor query-cached-p)) @@ -151,13 +156,14 @@ This method may be overrided by subclasses." (setf (query-cached-p query) t) query)))) -(defgeneric execute (query &optional params) +(defgeneric execute (query &optional params format) (:documentation "Execute `query` with `params` and return the results.") (:method ((query dbi-query) &optional params) (execute-using-connection (query-connection query) query - params))) + params + format))) (defgeneric fetch (query) (:documentation "Fetch the first row from `query` which is returned by `execute`.") @@ -191,7 +197,7 @@ This method may be overrided by subclasses.") (assert-transaction-is-in-progress state)) (call-next-method)))) -(defgeneric execute-using-connection (conn query params) +(defgeneric execute-using-connection (conn query params &optional format) (:documentation "Execute `query` in `conn`. This method must be implemented in each drivers.") (:method ((conn dbi-connection) (query dbi-query) params)