diff --git a/src/api.lisp b/src/api.lisp index 94896551d18f5472c16816b00ee837cb0cc42b62..666339451d94db86cc26dd7d127e9f28dcbb1394 100644 --- a/src/api.lisp +++ b/src/api.lisp @@ -79,7 +79,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Simple SQL Queries -(defun mysql-query (connection query-string) +(defun mysql-query (connection query-string + &key row-fn (as-text nil) (result-type 'vector)) "Send a SQL Query over the connection using the MySQL Text Protocol. For queries that return rows, returns two values: A vector of rows, each of which is a vector of columns. @@ -87,7 +88,10 @@ For queries that don't return rows, returns a QMYND:RESPONSE-OK-PACKET. May signal a QMYND:MYSQL-ERROR." (with-mysql-connection (connection) - (send-command-query query-string))) + (send-command-query query-string + :row-fn row-fn + :as-text as-text + :result-type result-type))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Prepared Statements diff --git a/src/mysql-protocol/response-result-set.lisp b/src/mysql-protocol/response-result-set.lisp index 92143666d926fe87d1757a78d3a1e01f9c7ab17e..9a1bd26db3468f4b9f95d1d3dfd3d23c6594a988 100644 --- a/src/mysql-protocol/response-result-set.lisp +++ b/src/mysql-protocol/response-result-set.lisp @@ -64,30 +64,81 @@ (mysql-cs-coll-to-character-encoding (column-definition-v41-packet-cs-coll column-definition)))) -(defun parse-resultset-rows (column-count column-definitions) - (flet ((parse-resultset-row () - (let* ((payload (mysql-read-packet)) - (tag (aref payload 0))) - (cond - ((or (and (= tag +mysql-response-end-of-file+) - (< (length payload) 9)) - (= tag +mysql-response-error+)) - (parse-response payload)) - (t - (flexi-streams:with-input-from-sequence (s payload) - (let ((row (make-array column-count :initial-element nil))) - (loop for i from 0 below column-count - for str = (read-length-encoded-string s :null-ok t) - when str - do (setf (aref row i) - (parse-text-protocol-result-column - str - (aref column-definitions i)))) - row))))))) - (coerce (loop for row = (parse-resultset-row) then (parse-resultset-row) - until (typep row 'response-end-of-file-packet) - collect row) - 'vector))) +(declaim (inline parse-resultset-row)) + +(defun parse-resultset-row (column-count column-definitions + &key as-text result-type) + "Parse a single row of the result set and return either a vector or a + list, depending on the value of RESULT-TYPE. + + If AS-TEXT is t, return only strings. The default for AS-TEXT is nil, in + which case the result columns are parsed into native types depending on + the meta data passed in COLUMNS-DEFINITIONS." + (let* ((payload (mysql-read-packet)) + (tag (aref payload 0))) + (labels + ((parse-column (str column-definition) + (when str + (if as-text + (let ((encoding + (or (column-definition-encoding column-definition) + babel::*default-character-encoding*))) + (babel:octets-to-string str :encoding encoding)) + (parse-text-protocol-result-column str column-definition)))) + + (result-as-vector (payload) + (flexi-streams:with-input-from-sequence (s payload) + (let ((row (make-array column-count :initial-element nil))) + (loop for i from 0 below column-count + for str = (read-length-encoded-string s :null-ok t) + when str + do (setf (aref row i) + (parse-column str (aref column-definitions i)))) + row))) + + (result-as-list (payload) + (flexi-streams:with-input-from-sequence (s payload) + (loop for i from 0 below column-count + for str = (read-length-encoded-string s :null-ok t) + collect (parse-column str (aref column-definitions i)))))) + (declare (inline parse-column + result-as-vector + result-as-list)) + (cond + ((or (and (= tag +mysql-response-end-of-file+) + (< (length payload) 9)) + (= tag +mysql-response-error+)) + (parse-response payload)) + (t + (ecase result-type + (vector (result-as-vector payload)) + (list (result-as-list payload)))))))) + +(defun map-resultset-rows (fn column-count column-definitions + &key as-text result-type) + "Call the FN function with a single row from the result-set at a time. + + When RESULT-TYPE is list, the row is a list, when RESULT-TYPE is vector, + the row passed to the FN function is a vector." + (loop for row = (parse-resultset-row column-count + column-definitions + :as-text as-text + :result-type result-type) + until (typep row 'response-end-of-file-packet) + do (funcall fn row))) + +(defun parse-resultset-rows (column-count column-definitions + &key as-text result-type) + "Accumulate the whole result set in memory then return it as a list or a + vector depending on the value of RESULT-TYPE (a symbol)." + (let ((rows + (loop for row = (parse-resultset-row column-count + column-definitions + :as-text as-text + :result-type result-type) + until (typep row 'response-end-of-file-packet) + collect row))) + (coerce rows result-type))) (defun parse-text-protocol-result-column (octets column-definition) (let ((column-type (column-definition-type column-definition)) diff --git a/src/mysql-protocol/text-protocol/command-query.lisp b/src/mysql-protocol/text-protocol/command-query.lisp index e9b09128bccb076a86fcf5e74e6d409980fb8691..90ec82acfe921dea557b8ebee5e6ff7e4469a46d 100644 --- a/src/mysql-protocol/text-protocol/command-query.lisp +++ b/src/mysql-protocol/text-protocol/command-query.lisp @@ -19,7 +19,23 @@ ;; ((tag :mysql-type (integer 1) :value +mysql-command-query+ :transient t :bind nil) ;; (query-string :mysql-type (string :eof)))) -(defun send-command-query (query-string) +(defun send-command-query (query-string + &key + row-fn + (as-text nil) + (result-type 'vector)) + "Send QUERY-STRING to the current MySQL connection. + + When the ROW-FN parameter is given, it must be a function and is called + with each row as input, and the rows are discarded once the function is + called. + + When AS-TEXT is t, the column values are not converted to native types + and returned as text instead. + + By default the resultset is a vector of rows where each row is itself a + vector of columns. When RESULT-TYPE is list, the result is a list of list + of columns instead." (mysql-command-init +mysql-command-query+) (mysql-write-packet (flexi-streams:with-output-to-sequence (s) @@ -30,12 +46,20 @@ (if (member tag (list +mysql-response-ok+ +mysql-response-error+)) (parse-response payload) (let* ((column-count (parse-column-count payload)) - (column-definitions (coerce - (loop - repeat column-count - collect (parse-column-definition-v41 (mysql-read-packet)) - ;; Consume the EOF packet or signal an error for an ERR packet. - finally (parse-response (mysql-read-packet))) - 'vector)) - (rows (parse-resultset-rows column-count column-definitions))) + (column-definitions + (coerce + (loop + repeat column-count + collect (parse-column-definition-v41 (mysql-read-packet)) + ;; Consume the EOF packet or signal an error for an ERR packet. + finally (parse-response (mysql-read-packet))) + 'vector)) + (rows + (if row-fn + (map-resultset-rows row-fn column-count column-definitions + :as-text as-text + :result-type result-type) + (parse-resultset-rows column-count column-definitions + :as-text as-text + :result-type result-type)))) (values rows column-definitions)))))