From 044499017f448a2e50b9bc921c9681eadb193fda Mon Sep 17 00:00:00 2001 From: Eitaro Fukamachi Date: Thu, 8 Aug 2024 05:57:09 +0000 Subject: [PATCH] Remove :format argument from `fetch-using-connection`. --- src/dbd/mysql.lisp | 35 ++++++------------------ src/dbd/postgres.lisp | 63 +++++++++++++------------------------------ src/dbd/sqlite3.lisp | 49 +++++---------------------------- src/driver.lisp | 62 +++++++++++++++++++++++------------------- 4 files changed, 66 insertions(+), 143 deletions(-) diff --git a/src/dbd/mysql.lisp b/src/dbd/mysql.lisp index 3daa43a..f8a800c 100644 --- a/src/dbd/mysql.lisp +++ b/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))) diff --git a/src/dbd/postgres.lisp b/src/dbd/postgres.lisp index f9ce6a0..355027c 100644 --- a/src/dbd/postgres.lisp +++ b/src/dbd/postgres.lisp @@ -135,7 +135,7 @@ (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 @@ -143,6 +143,14 @@ (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 diff --git a/src/dbd/sqlite3.lisp b/src/dbd/sqlite3.lisp index 409fd7d..58186b5 100644 --- a/src/dbd/sqlite3.lisp +++ b/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) diff --git a/src/driver.lisp b/src/driver.lisp index c15fb11..edf2f02 100644 --- a/src/driver.lisp +++ b/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,7 +120,7 @@ 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 @@ -130,11 +128,13 @@ Driver should be named like 'DBD-SOMETHING' for a database 'something'." (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)))