X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=1f54d44c430e6f261a6f7a7e509c470e035b0f79;hp=eb965cada4f7a3033dfe5213a90ba46684995899;hb=eb6238bfcd8e0359c813c24626cc0b435c7a04bf;hpb=2fb4a4ccc311f37b0f5e993976a4d7d4f667f4e3

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index eb965ca..1f54d44 100644
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -243,50 +243,69 @@
 
 (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 nil)
+        (num-fields 0))
+    (declare (type mysql-mysql-ptr-def mysql-ptr)
+             (type (or null mysql-mysql-res-ptr-def) 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 +318,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)