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

@@ -135,14 +135,22 @@
 
 (defmethod execute-using-connection ((conn dbd-postgres-connection) (cursor dbi-cursor) params)
   (assert (in-transaction conn))
-  (with-accessors ((sql cursor-sql)
+  (with-accessors ((sql query-sql)
                    (name cursor-name)
                    (formatter cursor-formatter))
       cursor
     (exec-query (connection-handle conn)
                 (format nil "DECLARE ~A CURSOR FOR ~A"
                         name
                         (funcall formatter params)))
+    (setf (query-fields cursor)
+          (first
+           (exec-query (connection-handle conn)
+                       (format nil "FETCH ~A" name)
+                       'field-row-reader)))
+    (exec-query (connection-handle conn)
+                (format nil "FETCH RELATIVE -1 ~A" name)
+                'cl-postgres:ignore-row-reader)
     (setf (cursor-declared-p cursor) t)
     cursor))
 
@@ -186,58 +194,23 @@
                              :results (list count)
                              :row-count count)))))))
 
-(def-row-reader plist-row-reader (fields)
+(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
-                      append (list (intern (field-name field) :keyword)
-                                   (next-field field)))))
-
-(def-row-reader hash-table-row-reader (fields)
-  (loop while (next-row)
-        collect (loop with hash = (make-hash-table :test 'equal)
-                      for field across fields
-                      do (setf (gethash (field-name field) hash)
-                               (next-field field))
-                      finally (return hash))))
+                      collect (field-name field)
+                      do (next-field field))))
+(declaim #+sbcl (sb-ext:unmuffle-conditions sb-ext:code-deletion-note))
 
-(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

@@ -28,8 +28,6 @@
            #:query-row-count
            #:query-cached-p
            #:dbi-cursor
-           #:cursor-connection
-           #:cursor-sql
            #:cursor-name
            #:cursor-formatter
            #:cursor-declared-p
@@ -122,19 +120,21 @@ Driver should be named like 'DBD-SOMETHING' for a database 'something'."
   "Return a list of direct subclasses for `dbi-driver`."
   (c2mop:class-direct-subclasses (find-class 'dbi-driver)))
 
-(defclass/a dbi-query ()
+(defclass dbi-query-base ()
   ((connection :type dbi-connection
                :initarg :connection
                :initform nil
                :accessor query-connection)
    (sql :type string
         :initarg :sql
         :accessor query-sql)
-   (prepared :type t
+   (fields :initarg :fields
+           :accessor query-fields)))
+
+(defclass/a dbi-query (dbi-query-base)
+  ((prepared :type t
              :initarg :prepared
              :accessor query-prepared)
-   (fields :initarg :fields
-           :accessor query-fields)
    (results :initarg :results
             :accessor query-results)
    (row-count :type (or integer null)
@@ -146,14 +146,8 @@ Driver should be named like 'DBD-SOMETHING' for a database 'something'."
            :accessor query-cached-p))
   (:documentation "Class that represents a prepared DB query."))
 
-(defclass dbi-cursor ()
-  ((connection :type dbi-connection
-               :initarg :connection
-               :accessor cursor-connection)
-   (sql :type string
-        :initarg :sql
-        :accessor cursor-sql)
-   (name :type string
+(defclass dbi-cursor (dbi-query-base)
+  ((name :type string
          :initform (random-string "cursor")
          :accessor cursor-name)
    (formatter :type function
@@ -191,23 +185,35 @@ This method may be overrided by subclasses."
 
 (defgeneric execute (query &optional params)
   (:documentation "Execute `query` with `params` and return the results.")
-  (:method ((query dbi-query) &optional params)
+  (:method (object &optional params)
     (execute-using-connection
-     (query-connection query)
-     query
-     params))
-  (:method ((cursor dbi-cursor) &optional params)
-    (execute-using-connection
-     (cursor-connection cursor)
-     cursor
+     (query-connection object)
+     object
      params)))
 
 (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 (query-connection object) object))
+          (fields (query-fields object)))
+      (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 +243,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)))