X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=ea66f3de3605dd16de43020a31ee458f5fa74f7a;hb=a3e1cd20eec3903790c6e8f126345558904488f4;hp=c3bbda1dff00b17da06de53ba52209cebb81290d;hpb=53e2f4aeaeb8a3ff843e5438472227d15caf1f09;p=clsql.git

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index c3bbda1..ea66f3d 100644
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -170,43 +170,6 @@
 		 :errno (mysql-errno mysql-ptr)
 		 :error (mysql-error-string mysql-ptr))))))
 
-#+ignore
-(defmethod database-query (query-expression (database mysql-database) 
-			   result-types)
-  (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
-  (let ((mysql-ptr (database-mysql-ptr database)))
-    (uffi:with-cstring (query-native query-expression)
-      (if (zerop (mysql-query mysql-ptr query-native))
-	  (let ((res-ptr (mysql-use-result mysql-ptr)))
-	    (if res-ptr
-		(unwind-protect
-		     (let ((num-fields (mysql-num-fields res-ptr)))
-		       (declare (fixnum num-fields))
-		       (setq result-types (canonicalize-types 
-				    result-types num-fields
-				    res-ptr))
-		       (loop for row = (mysql-fetch-row res-ptr)
-			     until (uffi:null-pointer-p row)
-			     collect
-			     (loop for i fixnum from 0 below num-fields
-				   collect
-				   (convert-raw-field
-				    (uffi:deref-array row '(:array
-							    (* :unsigned-char))
-						      i)
-				    result-types i))))
-		  (mysql-free-result res-ptr))
-		(error 'clsql-sql-error
-		       :database database
-		       :expression query-expression
-		       :errno (mysql-errno mysql-ptr)
-		       :error (mysql-error-string mysql-ptr))))
-	  (error 'clsql-sql-error
-		 :database database
-		 :expression query-expression
-		 :errno (mysql-errno mysql-ptr)
-		 :error (mysql-error-string mysql-ptr))))))
-
 (defmethod database-execute-command (sql-expression (database mysql-database))
   (uffi:with-cstring (sql-native sql-expression)
     (let ((mysql-ptr (database-mysql-ptr database)))
@@ -385,17 +348,16 @@
   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
 
 (defmethod database-sequence-next (sequence-name (database mysql-database))
-  (database-execute-command 
-   (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
-		" SET id=LAST_INSERT_ID(id+1)")
-   database)
-  (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
+  (without-interrupts
+   (database-execute-command 
+    (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
+		 " SET id=LAST_INSERT_ID(id+1)")
+    database)
+   (mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database))))
 
 (defmethod database-sequence-last (sequence-name (database mysql-database))
   (declare (ignore sequence-name)))
 
-
-
 (defmethod database-create (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
     (multiple-value-bind (output status)
@@ -415,7 +377,7 @@
 (defmethod database-destroy (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
     (multiple-value-bind (output status)
-	(clsql-base-sys:command-output "mysqladmin drop -u~A -p~A -h~A ~A"
+	(clsql-base-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
 				       user password 
 				       (if host host "localhost")
 				       name)
@@ -429,15 +391,21 @@
 	t))))
 
 (defmethod database-probe (connection-spec (type (eql :mysql)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+	      :key #'car :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
+    (declare (ignore name))
     (let ((database (database-connect (list host "mysql" user password) type)))
       (unwind-protect
-	  (when
-	      (find name (database-query "select db from db" 
-					 database :auto)
-		    :key #'car :test #'string-equal)
-	    t)
-	(database-disconnect database)))))
+	   (progn
+	     (setf (slot-value database 'clsql-base-sys::state) :open)
+	     (mapcar #'car (database-query "show databases" database :auto)))
+	(progn
+	  (database-disconnect database)
+	  (setf (slot-value database 'clsql-base-sys::state) :closed))))))
 
 
 (when (clsql-base-sys:database-type-library-loaded :mysql)