From 71c68c68c83c7dce7fb5e6243baa365f28f70ebe Mon Sep 17 00:00:00 2001 From: Russ Tyndall Date: Mon, 28 Jul 2014 14:41:24 -0400 Subject: [PATCH] Got multiple results sets working for mysql which solves the precedure call bug with a reproduction case of the error. All result sets from a mysql query are now returned as values EG: rows0 names0 rows1 names1 ... fix UnwashedMeme/clsql#4 --- CONTRIBUTORS | 1 + ChangeLog | 11 ++++ db-mysql/mysql-api.lisp | 6 ++ db-mysql/mysql-package.lisp | 1 + db-mysql/mysql-sql.lisp | 107 +++++++++++++++++++++--------------- tests/test-connection.lisp | 22 ++++++++ tests/test-init.lisp | 57 ++++++++++--------- tests/test-pool.lisp | 1 - 8 files changed, 135 insertions(+), 71 deletions(-) diff --git a/CONTRIBUTORS b/CONTRIBUTORS index f2cce13..19c5799 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -8,6 +8,7 @@ Marc Battyani (Large object support for postgresql, initial connection pool code Ryan Davis, Nathan Bird, & Russ Tyndall (sponsored by http://www.acceleration.net/programming/) Victor (vityok@github), sqlite3 backend updates and clsql_uffi long-long support Aaron Burrow, clsql_uffi unsigned integer bugs +Ilya Khaprov deadtrickster@github - mysql backend stored-procedure / multiple result set support diff --git a/ChangeLog b/ChangeLog index 86f7b49..4b16c13 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2014-07-29 Russ Tyndall + * mysql-api.lisp, mysql-sql.lisp, test-connection.lisp + Added code to the mysql backend to pull all result sets as + multiple args. This fixes a bug in the mysql backend where trying + to query after executing a stored procedure (even on a pooled + connection) would raise an error about the connection being out of + sync. The second result set for the stored procedure seems to be + empty, so not sure why we need to iterate past it. + + patch / bugreport provided by: Ilya Khaprov deadtrickster@github + 2014-06-11 Russ Tyndall * databases.lisp, sqlite3-sql.lisp Similar to and overriding the patch 2014-01-30 937a3d, adds a diff --git a/db-mysql/mysql-api.lisp b/db-mysql/mysql-api.lisp index 4532815..19d1f91 100644 --- a/db-mysql/mysql-api.lisp +++ b/db-mysql/mysql-api.lisp @@ -290,6 +290,12 @@ :module "mysql" :returning :void) +(declaim (inline mysql-next-result)) +(uffi:def-function "mysql_next_result" + ((mysql mysql-mysql)) + :module "mysql" + :returning :int) + (declaim (inline mysql-fetch-row)) (uffi:def-function "mysql_fetch_row" ((res mysql-mysql-res)) diff --git a/db-mysql/mysql-package.lisp b/db-mysql/mysql-package.lisp index 926254d..74a1955 100644 --- a/db-mysql/mysql-package.lisp +++ b/db-mysql/mysql-package.lisp @@ -103,6 +103,7 @@ #:mysql-use-result #:mysql-options #:mysql-free-result + #:mysql-next-result #:mysql-row-seek #:mysql-field-seek #:mysql-fetch-row diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index eb965ca..95ec0ec 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -243,50 +243,67 @@ (defmethod database-query (query-expression (database mysql-database) result-types field-names) - (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) - (let ((mysql-ptr (database-mysql-ptr database))) - (declare (type mysql-mysql-ptr-def mysql-ptr)) + (declare (optimize (speed 3))) + (let ((mysql-ptr (database-mysql-ptr database)) + (results nil) ;; all the results and column-names in reverse-order + res-ptr (num-fields 0)) + (declare (type mysql-mysql-ptr-def mysql-ptr res-ptr) + (fixnum num-fields)) (when (database-execute-command query-expression database) - (let ((res-ptr (mysql-use-result mysql-ptr))) - (declare (type mysql-mysql-res-ptr-def res-ptr)) - (if (and res-ptr (not (uffi:null-pointer-p res-ptr))) - (unwind-protect - (let ((num-fields (mysql-num-fields res-ptr))) - (declare (fixnum num-fields)) - (setq result-types (canonicalize-types - result-types res-ptr)) - (values - (loop for row = (mysql-fetch-row res-ptr) - for lengths = (mysql-fetch-lengths res-ptr) - until (uffi:null-pointer-p row) - collect - (do* ((rlist (make-list num-fields)) - (i 0 (1+ i)) - (pos rlist (cdr pos))) - ((= i num-fields) rlist) - (declare (fixnum i)) - (setf (car pos) - (convert-raw-field - (uffi:deref-array row '(:array - (* :unsigned-char)) - i) - (nth i result-types) - :length - (uffi:deref-array lengths '(:array :unsigned-long) i) - :encoding (encoding database))))) - (when field-names - (result-field-names res-ptr)))) - (mysql-free-result res-ptr)) - (unless (zerop (mysql-errno mysql-ptr)) - ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html - ;; if mysql_use_result or mysql_store_result return a null ptr, - ;; we use a mysql_errno check to see if it had a problem or just - ;; was a query without a result. If no error, just return nil. - (error 'sql-database-data-error - :database database - :expression query-expression - :error-id (mysql-errno mysql-ptr) - :message (mysql-error-string mysql-ptr)))))))) + (labels + ((get-row (row lengths) + "Pull a single row value from the results" + (loop for i from 0 below num-fields + collect + (convert-raw-field + (uffi:deref-array row '(:array (* :unsigned-char)) + (the fixnum i)) + (nth i result-types) + :length + (uffi:deref-array lengths '(:array :unsigned-long) + (the fixnum i)) + :encoding (encoding database)))) + (get-result-rows () + "get all the rows out of the now valid results set" + (loop for row = (mysql-fetch-row res-ptr) + for lengths = (mysql-fetch-lengths res-ptr) + until (uffi:null-pointer-p row) + collect (get-row row lengths))) + (do-result-set () + "for a mysql-ptr, grab and return a results set" + (setf res-ptr (mysql-use-result mysql-ptr)) + (cond + ((or (null res-ptr) (uffi:null-pointer-p res-ptr)) + (unless (zerop (mysql-errno mysql-ptr)) + ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html + ;; if mysql_use_result or mysql_store_result return a null ptr, + ;; we use a mysql_errno check to see if it had a problem or just + ;; was a query without a result. If no error, just return nil. + (error 'sql-database-data-error + :database database + :expression query-expression + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))) + (t + (unwind-protect + (progn (setf num-fields (mysql-num-fields res-ptr) + result-types (canonicalize-types + result-types res-ptr)) + (push (get-result-rows) results) + (push (when field-names + (result-field-names res-ptr)) + results)) + (mysql-free-result res-ptr)))))) + + (loop + do (do-result-set) + while (let ((next (mysql-next-result mysql-ptr))) + (case next + (0 t) ;Successful and there are more results + (-1 nil) ;Successful and there are no more results + (t nil) ;errors + ))) + (values-list (nreverse results)))))) (defstruct mysql-result-set @@ -299,6 +316,10 @@ (defmethod database-query-result-set ((query-expression string) (database mysql-database) &key full-set result-types) + ;; TODO: REFACTOR THIS IN TERMS OF database-query or vice-versa + ;; This doesnt seem to free database results reliably, dont think + ;; that we should allow that particularly, OTOH, dont know how + ;; we support cursoring without it (let ((mysql-ptr (database-mysql-ptr database))) (declare (type mysql-mysql-ptr-def mysql-ptr)) (when (database-execute-command query-expression database) diff --git a/tests/test-connection.lisp b/tests/test-connection.lisp index e15b682..3e742e7 100644 --- a/tests/test-connection.lisp +++ b/tests/test-connection.lisp @@ -55,4 +55,26 @@ (clsql-sys:query "DROP TABLE DUMMY")) nil nil) +(deftest :connection/pool/procedure-mysql + (unwind-protect + (progn + (clsql-sys:disconnect) + (test-connect :pool t) + (clsql-sys:execute-command + "CREATE PROCEDURE prTest () BEGIN SELECT 1 \"a\",2 \"b\",3 \"c\" ,4 \"d\" UNION SELECT 5,6,7,8; END;") + (clsql-sys:disconnect) + (test-connect :pool t) + (let ((p0 (clsql-sys:query "CALL prTest();" :flatp t))) + (clsql-sys:disconnect) + (test-connect :pool t) + (let ((p1 (clsql-sys:query "CALL prTest();" :flatp t))) + (clsql-sys:disconnect) + (test-connect :pool t) + (values p0 p1)))) + (ignore-errors + (clsql-sys:execute-command "DROP PROCEDURE prTest;")) + (test-connect)) + ((1 2 3 4) (5 6 7 8)) + ((1 2 3 4) (5 6 7 8))) + )) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index f13f1cc..d1de92e 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -46,24 +46,31 @@ (db-type-spec db-type (read-specs)))) (defun test-connect - (db-type - &key position pool - (spec (find-test-connection-spec db-type :position position)) - ) - (setf *test-database-type* db-type) - (setf *test-database-user* + (&key + (db-type *test-database-type* db-type-p) + position pool spec) + (unless spec + (setf spec + (or (and (null db-type-p) *test-connection-spec*) + (find-test-connection-spec db-type :position position)))) + (when *default-database* + (disconnect :database *default-database*)) + (setf *test-database-type* db-type + *test-database-user* (cond ((member db-type '(:oracle :odbc :aodbc)) (second spec)) - ((>= (length spec) 3) (third spec)))) - (let ((*default-database* (clsql:connect - spec - :database-type db-type - :make-default t - :if-exists :old - :pool pool))) - (setf *test-database-underlying-type* - (clsql-sys:database-underlying-type *default-database*)) - *default-database*)) + ((>= (length spec) 3) (third spec))) + *test-connection-spec* spec + *default-database* + (clsql:connect + spec + :database-type db-type + :make-default t + :if-exists :old + :pool pool) + *test-database-underlying-type* + (clsql-sys:database-underlying-type *default-database*)) + *default-database*) (defun test-setup-database (db-type &key (spec (find-test-connection-spec db-type))) (when (clsql-sys:db-backend-has-create/destroy-db? db-type) @@ -71,8 +78,7 @@ (ignore-errors (create-database spec :database-type db-type))) ;; Connect to the database - (test-connect db-type :spec spec) - + (test-connect :db-type db-type :spec spec) ;; Ensure database is empty (truncate-database :database *default-database*) @@ -133,12 +139,10 @@ (let ((suites (intersection suites (default-suites)))) (when suites (dolist (db-type +all-db-types+) - (dolist (spec (db-type-spec db-type specs)) - (let ((*test-connection-spec* spec) - (*test-connection-db-type* db-type)) - (format report-stream "~%~%Start Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2))) - (do-tests-for-backend db-type spec :suites suites) - (format report-stream "~%~%Finished Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2)))))))) + (dolist (spec (db-type-spec db-type specs)) + (format report-stream "~%~%Start Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2))) + (do-tests-for-backend db-type spec :suites suites) + (format report-stream "~%~%Finished Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2))))))) (zerop *error-count*))) (defun load-necessary-systems (specs) @@ -250,7 +254,8 @@ (cond ((and (not (eql db-underlying-type :mysql)) (clsql-sys:in test :connection/query-command - :basic/reallybigintegers/1)) + :basic/reallybigintegers/1 + :connection/pool/procedure-mysql)) (push (cons test "known to work only in MySQL as yet.") skip-tests)) ((and (null (clsql-sys:db-type-has-views? db-underlying-type)) (clsql-sys:in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4)) @@ -377,8 +382,6 @@ (defun rapid-load (type &optional (position 0)) "Rapid load for interactive testing." - (when *default-database* - (disconnect :database *default-database*)) (test-setup-database type :spec (find-test-connection-spec type :position position)) diff --git a/tests/test-pool.lisp b/tests/test-pool.lisp index ececcd6..ef0215b 100644 --- a/tests/test-pool.lisp +++ b/tests/test-pool.lisp @@ -80,5 +80,4 @@ (eq p (clsql-sys::find-or-create-connection-pool nil :dummy)) (eq p (clsql-sys::find-or-create-connection-pool :spec :dummy)))) nil T nil) - )) -- 2.34.1