r10561: 07 Jun 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 c87da8699df6835c8693bd704e349070b25adabf..ce81abe7e9ae0049643ac6f2e9b6c69d4157e01c 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -20,6 +20,12 @@
 
 (in-package #:clsql-mysql)
 
+;; if we have :sb-unicode, UFFI will treat :cstring as a UTF-8 string
+(defun expression-length (query-expression)
+  (length #+sb-unicode (sb-ext:string-to-octets query-expression
+                                               :external-format :utf8)
+         #-sb-unicode query-expression))
+
 ;;; Field conversion functions
 
 (defun result-field-names (num-fields res-ptr)
@@ -41,7 +47,7 @@
     (dotimes (i num-fields)
       (declare (fixnum i))
       (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
-            (flags (uffi:get-slot-value field 'mysql-field 'flags))
+            (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
@@ -95,16 +101,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)
@@ -123,7 +141,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
@@ -152,7 +175,7 @@
   (let ((mysql-ptr (database-mysql-ptr database)))
     (uffi:with-cstring (query-native query-expression)
       (if (zerop (mysql-real-query mysql-ptr query-native 
-                                   (length query-expression)))
+                                   (expression-length query-expression)))
          (let ((res-ptr (mysql-use-result mysql-ptr)))
            (if res-ptr
                (unwind-protect
@@ -198,7 +221,7 @@
     (let ((mysql-ptr (database-mysql-ptr database)))
       (declare (type mysql-mysql-ptr-def mysql-ptr))
       (if (zerop (mysql-real-query mysql-ptr sql-native 
-                                   (length sql-expression)))
+                                   (expression-length sql-expression)))
          t
        (error 'sql-database-data-error
               :database database
@@ -221,7 +244,7 @@
     (let ((mysql-ptr (database-mysql-ptr database)))
      (declare (type mysql-mysql-ptr-def mysql-ptr))
       (if (zerop (mysql-real-query mysql-ptr query-native
-                                   (length query-expression)))
+                                   (expression-length query-expression)))
          (let ((res-ptr (if full-set
                             (mysql-store-result mysql-ptr)
                           (mysql-use-result mysql-ptr))))
@@ -403,11 +426,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)))
@@ -418,12 +442,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
@@ -438,9 +462,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)
@@ -489,7 +513,7 @@
             :message (mysql-error-string mysql-ptr)))
 
     (uffi:with-cstring (native-query sql-stmt)
-      (unless (zerop (mysql-stmt-prepare stmt native-query (length sql-stmt)))
+      (unless (zerop (mysql-stmt-prepare stmt native-query (expression-length sql-stmt)))
        (mysql-stmt-close stmt)
        (error 'sql-database-error
               :error-id (mysql-errno mysql-ptr)