X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=cf85c591e8645d4da4374548e73caa077995b163;hp=e62dcbd8b22dacd110e451d77ecf678f9798a326;hb=8a8ee2d7d791b7a3efaed06420802a925d16fca3;hpb=8b5250e14e3280bdc4641c3b35a8dc68ca4dbde7

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index e62dcbd..cf85c59 100644
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -14,7 +14,7 @@
 ;;;; *************************************************************************
 
 (defpackage #:clsql-mysql
-    (:use #:common-lisp #:clsql-base-sys #:mysql #:clsql-uffi)
+    (:use #:common-lisp #:clsql-sys #:mysql #:clsql-uffi)
     (:export #:mysql-database)
     (:documentation "This is the CLSQL interface to MySQL."))
 
@@ -28,7 +28,7 @@
 	(field-vec (mysql-fetch-fields res-ptr)))
     (dotimes (i num-fields)
       (declare (fixnum i))
-      (let* ((field (uffi:deref-array field-vec '(:array (* mysql-field)) i))
+      (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
              (name (uffi:convert-from-foreign-string
                     (uffi:get-slot-value field 'mysql-field 'mysql::name))))
         (push name names)))
@@ -40,7 +40,7 @@
         (field-vec (mysql-fetch-fields res-ptr)))
     (dotimes (i num-fields)
       (declare (fixnum i))
-      (let* ((field (uffi:deref-array field-vec '(:array (* mysql-field)) i))
+      (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
 	      (type (uffi:get-slot-value field 'mysql-field 'type)))
 	(push
 	 (case type
@@ -298,7 +298,7 @@
   (do ((results nil)
        (rows (database-query 
 	      (format nil "SHOW INDEX FROM ~A" (string-upcase table))
-	      database nil)
+	      database nil nil)
 	     (cdr rows)))
       ((null rows) (nreverse results))
     (let ((col (nth 2 (car rows))))
@@ -311,23 +311,27 @@
   (mapcar #'car
 	  (database-query
 	   (format nil "SHOW COLUMNS FROM ~A" table)
-	   database nil)))
+	   database nil nil)))
 
 (defmethod database-attribute-type (attribute (table string)
 				    (database mysql-database)
                                     &key (owner nil))
   (declare (ignore owner))
-  (let ((result
-         (mapcar #'cadr
-                 (database-query
-                  (format nil
-                          "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
-                  database nil))))
-    (let* ((str (car result))
-	   (end-str (position #\( str))
-	   (substr (subseq str 0 end-str)))
-      (if substr
-      (intern (string-upcase substr) :keyword) nil))))
+  (let ((row (car (database-query
+		   (format nil
+			   "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
+		   database nil nil))))
+    (let* ((raw-type (second row))
+	   (null (third row))
+	   (start-length (position #\( raw-type))
+	   (type (if start-length
+		     (subseq raw-type 0 start-length)
+		     raw-type))
+	   (length (when start-length
+		     (parse-integer (subseq raw-type (1+ start-length))
+				    :junk-allowed t))))
+      (when type
+	(values (ensure-keyword type) length nil (if (string-equal null "YES") 1 0))))))
 
 ;;; Sequence functions
 
@@ -388,7 +392,7 @@
 (defmethod database-create (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
     (multiple-value-bind (output status)
-	(clsql-base-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A"
+	(clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A"
 				       user password 
 				       (if host host "localhost")
 				       name)
@@ -404,7 +408,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 -f -u~A -p~A -h~A ~A"
+	(clsql-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
 				       user password 
 				       (if host host "localhost")
 				       name)
@@ -428,11 +432,11 @@
     (let ((database (database-connect (list host "mysql" user password) type)))
       (unwind-protect
 	   (progn
-	     (setf (slot-value database 'clsql-base-sys::state) :open)
+	     (setf (slot-value database 'clsql-sys::state) :open)
 	     (mapcar #'car (database-query "show databases" database :auto nil)))
 	(progn
 	  (database-disconnect database)
-	  (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+	  (setf (slot-value database 'clsql-sys::state) :closed))))))
 
 ;;; Database capabilities
 
@@ -454,6 +458,6 @@
   (let ((tuple (car (database-query "SHOW VARIABLES LIKE 'HAVE_INNODB'" database :auto nil))))
     (and tuple (string-equal "YES" (second tuple)))))
 
-(when (clsql-base-sys:database-type-library-loaded :mysql)
-  (clsql-base-sys:initialize-database-type :database-type :mysql))
+(when (clsql-sys:database-type-library-loaded :mysql)
+  (clsql-sys:initialize-database-type :database-type :mysql))