X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=ce81abe7e9ae0049643ac6f2e9b6c69d4157e01c;hp=2945258de5f292f1f668a278a7f446e038d78d91;hb=06dfb268002579b31e8de6888c917f212fd1be1f;hpb=4e598a5e04818207730914f609f953dac439c566

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index 2945258..ce81abe 100644
--- 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)
@@ -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)