r10383: 06 Apr 2005 Kevin Rosenberg <kevin@rosenberg.net>

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

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index 5f1306811fdc2f9d6836591909cc661242ac4238..5468ac5075c914ca53ec45c7ec639eb7ea288363 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -41,16 +41,25 @@
     (dotimes (i num-fields)
       (declare (fixnum i))
       (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
-            (type (uffi:get-slot-value field 'mysql-field 'type)))
+            (flags (uffi:get-slot-value field 'mysql-field 'mysql::flags))
+            (unsigned (plusp (logand flags 32)))
+            (type (uffi:get-slot-value field 'mysql-field 'type)))
        (push
         (case type
           ((#.mysql-field-types#tiny 
             #.mysql-field-types#short
-            #.mysql-field-types#int24
-            #.mysql-field-types#long)
-           :int32)
-          (#.mysql-field-types#longlong
-           :int64)
+            #.mysql-field-types#int24)
+           (if unsigned
+               :uint32
+             :int32))
+          (#.mysql-field-types#long
+           (if unsigned
+               :uint
+             :int))
+           (#.mysql-field-types#longlong
+            (if unsigned
+                :uint64
+              :int64))
           ((#.mysql-field-types#double
             #.mysql-field-types#float
             #.mysql-field-types#decimal)
@@ -86,16 +95,28 @@
   :mysql)
 
 (defmethod database-name-from-spec (connection-spec (database-type (eql :mysql)))
-  (check-connection-spec connection-spec database-type (host db user password))
-  (destructuring-bind (host db user password) connection-spec
+  (check-connection-spec connection-spec database-type
+                        (host db user password &optional port))
+  (destructuring-bind (host db user password &optional port) connection-spec
     (declare (ignore password))
     (concatenate 'string 
-                (if host host "localhost")
+                (etypecase host
+                  (null "localhost")
+                  (pathname (namestring host))
+                  (string host))
+                (if port 
+                    (concatenate 'string
+                                 ":"
+                                 (etypecase port
+                                   (integer (write-to-string port))
+                                   (string port)))
+                    "")
                 "/" db "/" user)))
 
 (defmethod database-connect (connection-spec (database-type (eql :mysql)))
-  (check-connection-spec connection-spec database-type (host db user password))
-  (destructuring-bind (host db user password) connection-spec
+  (check-connection-spec connection-spec database-type
+                        (host db user password &optional port))
+  (destructuring-bind (host db user password &optional port) connection-spec
     (let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql)))
          (socket nil))
       (if (uffi:null-pointer-p mysql-ptr)
@@ -114,7 +135,12 @@
                (if (uffi:null-pointer-p 
                     (mysql-real-connect 
                      mysql-ptr host-native user-native password-native
-                     db-native 0 socket-native 0))
+                     db-native
+                     (etypecase port
+                       (null 0)
+                       (integer port)
+                       (string (parse-integer port)))
+                     socket-native 0))
                    (progn
                      (setq error-occurred t)
                      (error 'sql-connection-error
@@ -394,11 +420,12 @@
           database :auto nil))))
 
 (defmethod database-create (connection-spec (type (eql :mysql)))
-  (destructuring-bind (host name user password) connection-spec
+  (destructuring-bind (host name user password &optional port) connection-spec
     (multiple-value-bind (output status)
-       (clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A"
+       (clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A~@[ -P~A~] ~A"
                                       user password 
                                       (if host host "localhost")
+                                      port name
                                       name)
       (if (or (not (eql 0 status))
              (and (search "failed" output) (search "error" output)))
@@ -409,12 +436,12 @@
        t))))
 
 (defmethod database-destroy (connection-spec (type (eql :mysql)))
-  (destructuring-bind (host name user password) connection-spec
+  (destructuring-bind (host name user password &optional port) connection-spec
     (multiple-value-bind (output status)
-       (clsql-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~@[ -P~A~] ~A"
                                       user password 
                                       (if host host "localhost")
-                                      name)
+                                      port name)
       (if (or (not (eql 0 status))
              (and (search "failed" output) (search "error" output)))
          (error 'sql-database-error
@@ -429,9 +456,9 @@
     t))
 
 (defmethod database-list (connection-spec (type (eql :mysql)))
-  (destructuring-bind (host name user password) connection-spec
+  (destructuring-bind (host name user password &optional port) connection-spec
     (declare (ignore name))
-    (let ((database (database-connect (list host "mysql" user password) type)))
+    (let ((database (database-connect (list host "mysql" user password port) type)))
       (unwind-protect
           (progn
             (setf (slot-value database 'clsql-sys::state) :open)
@@ -523,7 +550,7 @@
          (dotimes (i num-fields)
            (declare (fixnum i))
            (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
-                  (type (uffi:get-slot-value field mysql-field 'type))
+                  (type (uffi:get-slot-value field 'mysql-field 'type))
                   (binding (uffi:deref-array output-bind '(:array mysql-bind) i)))
              (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type) type)