Add :format option to dbi:execute to specify the data type for each…

… row.

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,20 +102,23 @@
     (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))
 
 (defmethod fetch-using-connection ((conn dbd-mysql-connection) query)
   (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)))

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)))

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)

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)