Remove :format argument from fetch-using-connection.

src/dbd/mysql.lisp

@@ -90,33 +90,14 @@
        (setf (query-results query) handle)))
     query))
 
-(defmethod fetch-using-connection ((conn dbd-mysql-connection) query format)
-  (let* ((result (query-results query))
-         (row
-           (if (mysql-result-list-p result)
-               (pop (slot-value result 'result-set))
-               (next-row result)))
-         (fields (if (slot-boundp query 'dbi.driver::fields)
-                     (query-fields query)
-                     (setf (query-fields query)
-                           (mapcar #'first (first (result-set-fields result)))))))
-    (ecase format
-      (:plist
-       (loop for field in fields
-             for value in row
-             collect (intern field :keyword)
-             collect value))
-      (:alist
-       (loop for field in fields
-             for value in row
-             collect (cons field value)))
-      (: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))
-      (:values row))))
+(defmethod fetch-using-connection ((conn dbd-mysql-connection) query)
+  (let ((result (query-results query)))
+    (unless (slot-boundp query 'dbi.driver::fields)
+      (setf (query-fields query)
+            (mapcar #'first (first (result-set-fields result)))))
+    (if (mysql-result-list-p result)
+        (pop (slot-value result 'result-set))
+        (next-row result))))
 
 (defmethod escape-sql ((conn dbd-mysql-connection) (sql string))
   (escape-string sql :database (connection-handle conn)))

src/dbd/postgres.lisp

@@ -143,6 +143,10 @@
                 (format nil "DECLARE ~A CURSOR FOR ~A"
                         name
                         (funcall formatter params)))
+    (setf (cursor-fields cursor)
+          (exec-query (connection-handle conn)
+                      (format nil "FETCH FORWARD 0 ~A" name)
+                      'field-row-reader))
     (setf (cursor-declared-p cursor) t)
     cursor))
 
@@ -186,6 +190,13 @@
                              :results (list count)
                              :row-count count)))))))
 
+(declaim #+sbcl (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+(def-row-reader field-row-reader (fields)
+  (loop while (next-row)
+        collect (loop for field across fields
+                      collect (field-name field))))
+(declaim #+sbcl (sb-ext:unmuffle-conditions sb-ext:code-deletion-note))
+
 (def-row-reader plist-row-reader (fields)
   (loop while (next-row)
         collect (loop for field across fields
@@ -200,44 +211,15 @@
                                (next-field field))
                       finally (return hash))))
 
-(defmethod fetch-using-connection ((conn dbd-postgres-connection) (cursor dbi-cursor) format)
-  (unless (cursor-declared-p cursor)
-    (error "The cursor is not declared yet."))
+(defmethod fetch-using-connection ((conn dbd-postgres-connection) (cursor dbi-cursor))
   (first
    (exec-query (connection-handle conn)
                (format nil "FETCH ~A" (cursor-name cursor))
-               (ecase format
-                 (:plist
-                  'plist-row-reader)
-                 (:alist
-                  'cl-postgres:alist-row-reader)
-                 (:hash-table
-                  'hash-table-row-reader)
-                 (:values
-                  'cl-postgres:list-row-reader)))))
+               'cl-postgres:list-row-reader)))
 
-(defmethod fetch-using-connection ((conn dbd-postgres-connection) (query dbi-query) format)
+(defmethod fetch-using-connection ((conn dbd-postgres-connection) (query dbi-query))
   (declare (ignore conn))
-  (let ((fields (query-fields query))
-        (row (pop (query-results query))))
-    (ecase format
-      (:plist
-       (loop for field in fields
-             for value in row
-             collect (intern field :keyword)
-             collect value))
-      (:alist
-       (loop for field in fields
-             for value in row
-             collect (cons field value)))
-      (: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))
-      (:values
-       row))))
+  (pop (query-results query)))
 
 (defmethod do-sql ((conn dbd-postgres-connection) sql &optional params)
   (if params

src/dbd/sqlite3.lisp

@@ -66,7 +66,7 @@
       ((sqlite3-use-store query)
        (setf (query-results query)
              (loop for count from 0
-                   for row = (fetch-using-connection conn query :values)
+                   for row = (fetch-using-connection conn query)
                    while row
                    collect row into rows
                    finally
@@ -95,29 +95,10 @@
       (sql-log sql params row-count took-usec)
       (values row-count))))
 
-(defmethod fetch-using-connection ((conn dbd-sqlite3-connection) (query dbd-sqlite3-query) format)
+(defmethod fetch-using-connection ((conn dbd-sqlite3-connection) (query dbd-sqlite3-query))
   (declare (ignore conn))
   (if (slot-boundp query 'dbi.driver::results)
-      (let ((row (pop (query-results query)))
-            (fields (query-fields query)))
-        (ecase format
-          (:plist
-           (loop for field in fields
-                 for value in row
-                 collect (intern field :keyword)
-                 collect value))
-          (:alist
-           (loop for field in fields
-                 for value in row
-                 collect (cons field value)))
-          (: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))
-          (:values
-           row)))
+      (pop (query-results query))
       (let ((prepared (query-prepared query)))
         (when (handler-case (step-statement prepared)
                 (sqlite-error (e)
@@ -128,27 +109,9 @@
                             (query-fields query)
                             (setf (query-fields query)
                                   (statement-column-names prepared)))))
-            (ecase format
-              (:plist
-               (loop for column in fields
-                     for i from 0
-                     collect (intern column :keyword)
-                     collect (statement-column-value prepared i)))
-              (:alist
-               (loop for column in fields
-                     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 fields
-                       for i from 0
-                       do (setf (gethash column hash)
-                                (statement-column-value prepared i)))
-                 hash))
-              (:values
-               (loop repeat (length fields)
-                     for i from 0
-                     collect (statement-column-value prepared i)))))))))
+            (loop repeat (length fields)
+                  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

@@ -31,6 +31,7 @@
            #:cursor-connection
            #:cursor-sql
            #:cursor-name
+           #:cursor-fields
            #:cursor-formatter
            #:cursor-declared-p
            #:make-cursor
@@ -156,6 +157,8 @@ Driver should be named like 'DBD-SOMETHING' for a database 'something'."
    (name :type string
          :initform (random-string "cursor")
          :accessor cursor-name)
+   (fields :initarg :fields
+           :accessor cursor-fields)
    (formatter :type function
               :accessor cursor-formatter)
    (declared :type boolean
@@ -204,10 +207,27 @@ This method may be overrided by subclasses."
 
 (defgeneric fetch (query &key format)
   (:documentation "Fetch the first row from `query` which is returned by `execute`.")
-  (:method ((query dbi-query) &key (format *row-format*))
-    (fetch-using-connection (query-connection query) query format))
-  (:method ((cursor dbi-cursor) &key (format *row-format*))
-    (fetch-using-connection (cursor-connection cursor) cursor format)))
+  (:method (object &key (format *row-format*))
+    (let ((values
+            (fetch-using-connection (slot-value object 'connection) object))
+          (fields (slot-value object 'fields)))
+      (ecase format
+        (:plist
+         (loop for field in fields
+               for value in values
+               collect (intern field :keyword)
+               collect value))
+        (:alist
+         (loop for field in fields
+               for value in values
+               collect (cons field value)))
+        (:hash-table
+         (loop with hash = (make-hash-table :test 'equal)
+               for field in fields
+               for value in values
+               do (setf (gethash field hash) value)
+               finally (return hash)))
+        (:values values)))))
 
 (defgeneric fetch-all (query &key format)
   (:documentation "Fetch all rest rows from `query`.")
@@ -237,8 +257,8 @@ This method may be overrided by subclasses."
                     hash))
                  (:values row))))))
 
-(defgeneric fetch-using-connection (conn query format)
-  (:method ((conn dbi-connection) (query dbi-query) format)
+(defgeneric fetch-using-connection (conn query)
+  (:method ((conn dbi-connection) (query dbi-query))
     (error 'dbi-unimplemented-error
            :method-name 'fetch-using-connection)))