projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r10565: new build env
[clsql.git]
/
db-mysql
/
mysql-sql.lisp
diff --git
a/db-mysql/mysql-sql.lisp
b/db-mysql/mysql-sql.lisp
index 82f43b8b177513a15714e5c05e37d9229714c86b..ce81abe7e9ae0049643ac6f2e9b6c69d4157e01c 100644
(file)
--- a/
db-mysql/mysql-sql.lisp
+++ b/
db-mysql/mysql-sql.lisp
@@
-20,6
+20,12
@@
(in-package #:clsql-mysql)
(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)
;;; Field conversion functions
(defun result-field-names (num-fields res-ptr)
@@
-41,16
+47,25
@@
(dotimes (i num-fields)
(declare (fixnum i))
(let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
(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
(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)
((#.mysql-field-types#double
#.mysql-field-types#float
#.mysql-field-types#decimal)
@@
-86,16
+101,28
@@
:mysql)
(defmethod database-name-from-spec (connection-spec (database-type (eql :mysql)))
: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
(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)))
"/" 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)
(let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql)))
(socket nil))
(if (uffi:null-pointer-p mysql-ptr)
@@
-114,7
+141,12
@@
(if (uffi:null-pointer-p
(mysql-real-connect
mysql-ptr host-native user-native password-native
(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
(progn
(setq error-occurred t)
(error 'sql-connection-error
@@
-143,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
(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 ((res-ptr (mysql-use-result mysql-ptr)))
(if res-ptr
(unwind-protect
@@
-189,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
(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
t
(error 'sql-database-data-error
:database database
@@
-212,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
(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))))
(let ((res-ptr (if full-set
(mysql-store-result mysql-ptr)
(mysql-use-result mysql-ptr))))
@@
-387,14
+419,19
@@
(mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database))))
(defmethod database-sequence-last (sequence-name (database mysql-database))
(mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database))))
(defmethod database-sequence-last (sequence-name (database mysql-database))
- (declare (ignore sequence-name)))
+ (without-interrupts
+ (caar (database-query
+ (concatenate 'string "SELECT id from "
+ (%sequence-name-to-table sequence-name))
+ database :auto nil))))
(defmethod database-create (connection-spec (type (eql :mysql)))
(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)
(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")
user password
(if host host "localhost")
+ port name
name)
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
name)
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
@@
-405,12
+442,12
@@
t))))
(defmethod database-destroy (connection-spec (type (eql :mysql)))
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)
(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")
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
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
(error 'sql-database-error
@@
-425,9
+462,9
@@
t))
(defmethod database-list (connection-spec (type (eql :mysql)))
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))
(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)
(unwind-protect
(progn
(setf (slot-value database 'clsql-sys::state) :open)
@@
-476,7
+513,7
@@
:message (mysql-error-string mysql-ptr)))
(uffi:with-cstring (native-query sql-stmt)
: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)
(mysql-stmt-close stmt)
(error 'sql-database-error
:error-id (mysql-errno mysql-ptr)
@@
-519,7
+556,7
@@
(dotimes (i num-fields)
(declare (fixnum i))
(let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
(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)
(binding (uffi:deref-array output-bind '(:array mysql-bind) i)))
(setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type) type)