(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)
(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
: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)
(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
(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
(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
(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))))
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)))
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
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)
: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)