(defpackage #:clsql-mysql
(:use #:common-lisp #:clsql-sys #:mysql #:clsql-uffi)
(:export #:mysql-database)
+ (:import-from :clsql-sys
+ :escaped :unescaped :combine-database-identifiers
+ :escaped-database-identifier :unescaped-database-identifier :database-identifier
+ :%sequence-name-to-table :%table-name-to-sequence-name)
(:documentation "This is the CLSQL interface to MySQL."))
(in-package #:clsql-mysql)
(defmethod database-name-from-spec (connection-spec (database-type (eql :mysql)))
(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))
+ (host db user password &optional port options))
+ (destructuring-bind (host db user password &optional port options) connection-spec
+ (declare (ignore password options))
(concatenate 'string
(etypecase host
(null "localhost")
"")
"/" db "/" user)))
+(defun lookup-option-code (option)
+ (if (assoc option +mysql-option-parameter-map+)
+ (symbol-value (intern
+ (concatenate 'string (symbol-name-default-case "mysql-option#")
+ (symbol-name option))
+ (symbol-name '#:mysql)))
+ (progn
+ (warn "Unknown mysql option name ~A - ignoring.~%" option)
+ nil)))
+
+(defun set-mysql-options (mysql-ptr options)
+ (flet ((lookup-option-type (option)
+ (cdr (assoc option +mysql-option-parameter-map+))))
+ (dolist (option options)
+ (if (atom option)
+ (let ((option-code (lookup-option-code option)))
+ (when option-code
+ (mysql-options mysql-ptr option-code uffi:+null-cstring-pointer+)))
+ (destructuring-bind (name . value) option
+ (let ((option-code (lookup-option-code name)))
+ (when option-code
+ (case (lookup-option-type name)
+ (:none
+ (mysql-options mysql-ptr option-code uffi:+null-cstring-pointer+))
+ (:char-ptr
+ (if (stringp value)
+ (uffi:with-foreign-string (fs value)
+ (mysql-options mysql-ptr option-code fs))
+ (warn "Expecting string argument for mysql option ~A, got ~A ~
+- ignoring.~%"
+ name value)))
+ (:uint-ptr
+ (if (integerp value)
+ (uffi:with-foreign-object (fo :unsigned-int)
+ (setf (uffi:deref-pointer fo :unsigned-int) value)
+ (mysql-options mysql-ptr option-code fo))
+ (warn "Expecting integer argument for mysql option ~A, got ~A ~
+- ignoring.~%"
+ name value)))
+ (:boolean-ptr
+ (uffi:with-foreign-object (fo :byte)
+ (setf (uffi:deref-pointer fo :byte)
+ (if (or (zerop value) (null value))
+ 0
+ 1))
+ (mysql-options mysql-ptr option-code fo)))))))))))
+
(defmethod database-connect (connection-spec (database-type (eql :mysql)))
(check-connection-spec connection-spec database-type
- (host db user password &optional port))
- (destructuring-bind (host db user password &optional port) connection-spec
+ (host db user password &optional port options))
+ (destructuring-bind (host db user password &optional port options) connection-spec
(let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql)))
(socket nil))
(if (uffi:null-pointer-p mysql-ptr)
(password-native password)
(db-native db)
(socket-native socket))
+ (when options
+ (set-mysql-options mysql-ptr options))
(let ((error-occurred nil))
(unwind-protect
(if (uffi:null-pointer-p
(uffi:deref-array row '(:array
(* :unsigned-char))
i)
- result-types i
- (uffi:deref-array lengths '(:array :unsigned-long)
- i)))))
+ (nth i result-types)
+ :length
+ (uffi:deref-array lengths '(:array :unsigned-long) i)
+ :encoding (encoding database)))))
(when field-names
(result-field-names res-ptr))))
(mysql-free-result res-ptr))
(setf (car rest)
(convert-raw-field
(uffi:deref-array row '(:array (* :unsigned-char)) i)
- types
- i
- (uffi:deref-array lengths '(:array :unsigned-long) i))))
+ (nth i types)
+ :length
+ (uffi:deref-array lengths '(:array :unsigned-long) i)
+ :encoding (encoding database))))
list)))
(declare (ignore owner))
(do ((results nil)
(rows (database-query
- (format nil "SHOW INDEX FROM ~A" table)
+ (format nil "SHOW INDEX FROM ~A" (escaped-database-identifier
+ table database))
database nil nil)
(cdr rows)))
((null rows) (nreverse results))
(declare (ignore owner))
(mapcar #'car
(database-query
- (format nil "SHOW COLUMNS FROM ~A" table)
+ (format nil "SHOW COLUMNS FROM ~A" (escaped-database-identifier
+ table database))
database nil nil)))
(defmethod database-attribute-type (attribute (table string)
(declare (ignore owner))
(let ((row (car (database-query
(format nil
- "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
+ "SHOW COLUMNS FROM ~A LIKE '~A'"
+ (escaped-database-identifier
+ table database)
+ (unescaped-database-identifier
+ attribute database))
database nil nil))))
(let* ((raw-type (second row))
(null (third row))
;;; Sequence functions
-(defun %sequence-name-to-table (sequence-name)
- (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name)))
-
-(defun %table-name-to-sequence-name (table-name)
- (and (>= (length table-name) 11)
- (string-equal (subseq table-name 0 11) "_CLSQL_SEQ_")
- (subseq table-name 11)))
-
(defmethod database-create-sequence (sequence-name
(database mysql-database))
- (let ((table-name (%sequence-name-to-table sequence-name)))
+ (let ((table-name (%sequence-name-to-table sequence-name database)))
(database-execute-command
(concatenate 'string "CREATE TABLE " table-name
" (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
(defmethod database-drop-sequence (sequence-name
(database mysql-database))
(database-execute-command
- (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
+ (concatenate 'string "DROP TABLE "
+ (%sequence-name-to-table sequence-name database))
database))
(defmethod database-list-sequences ((database mysql-database)
(declare (ignore owner))
(mapcan #'(lambda (s)
(let ((sn (%table-name-to-sequence-name (car s))))
- (and sn (list sn))))
+ (and sn (list (car s) sn))))
(database-query "SHOW TABLES" database nil nil)))
(defmethod database-set-sequence-position (sequence-name
(position integer)
(database mysql-database))
(database-execute-command
- (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name)
+ (format nil "UPDATE ~A SET id=~A" (%sequence-name-to-table sequence-name database)
position)
database)
(mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database)))
(defmethod database-sequence-next (sequence-name (database mysql-database))
(without-interrupts
(database-execute-command
- (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
+ (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name database)
" SET id=LAST_INSERT_ID(id+1)")
database)
(mysql:mysql-insert-id (clsql-mysql::database-mysql-ptr database))))
(without-interrupts
(caar (database-query
(concatenate 'string "SELECT id from "
- (%sequence-name-to-table sequence-name))
+ (%sequence-name-to-table sequence-name database))
database :auto nil))))
+(defmethod database-last-auto-increment-id ((database mysql-database) table column)
+ (declare (ignore table column))
+ (car (query "SELECT LAST_INSERT_ID();"
+ :flatp t :field-names nil
+ :database database)))
+
(defmethod database-create (connection-spec (type (eql :mysql)))
(destructuring-bind (host name user password) connection-spec
(let ((database (database-connect (list host "" user password)
t))
(defmethod database-list (connection-spec (type (eql :mysql)))
- (destructuring-bind (host name user password &optional port) connection-spec
+ (destructuring-bind (host name user password &optional port options) connection-spec
+ (declare (ignore options))
(let ((database (database-connect (list host (or name "mysql")
user password port) type)))
(unwind-protect
((#.mysql-field-types#var-string #.mysql-field-types#string
#.mysql-field-types#tiny-blob #.mysql-field-types#blob
#.mysql-field-types#medium-blob #.mysql-field-types#long-blob)
- (uffi:convert-from-foreign-string buffer))
- (#.mysql-field-types#tiny
- (uffi:ensure-char-integer
- (uffi:deref-pointer buffer :byte)))
- (#.mysql-field-types#short
- (uffi:deref-pointer buffer :short))
- (#.mysql-field-types#long
- (uffi:deref-pointer buffer :int))
- #+64bit
- (#.mysql-field-types#longlong
+ (uffi:convert-from-foreign-string buffer :encoding (encoding (database stmt))))
+ (#.mysql-field-types#tiny
+ (uffi:ensure-char-integer
+ (uffi:deref-pointer buffer :byte)))
+ (#.mysql-field-types#short
+ (uffi:deref-pointer buffer :short))
+ (#.mysql-field-types#long
+ (uffi:deref-pointer buffer :int))
+ #+64bit
+ (#.mysql-field-types#longlong
(uffi:deref-pointer buffer :long))
- (#.mysql-field-types#float
- (uffi:deref-pointer buffer :float))
- (#.mysql-field-types#double
- (uffi:deref-pointer buffer :double))
+ (#.mysql-field-types#float
+ (uffi:deref-pointer buffer :float))
+ (#.mysql-field-types#double
+ (uffi:deref-pointer buffer :double))
((#.mysql-field-types#time #.mysql-field-types#date
#.mysql-field-types#datetime #.mysql-field-types#timestamp)
(let ((year (uffi:get-slot-value buffer 'mysql-time 'mysql::year))
(day (uffi:get-slot-value buffer 'mysql-time 'mysql::day))
(hour (uffi:get-slot-value buffer 'mysql-time 'mysql::hour))
(minute (uffi:get-slot-value buffer 'mysql-time 'mysql::minute))
- (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
+ (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
(db-timestring
(make-time :year year :month month :day day :hour hour
:minute minute :second second))))
projects / clsql.git / blobdiff