Got multiple results sets working for mysql which solves the precedure

[clsql.git] / db-mysql / mysql-sql.lisp

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index eb965cada4f7a3033dfe5213a90ba46684995899..95ec0eceb32f910dabf5c2cc96d6d6621de38abb 100644 (file)
--- 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)