X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=0038da9cc364bad7a0959984521d5b78fcb446f0;hb=b50166ae0ba2bc09a9094c0e675ec92010b7293e;hp=14d20bc8e245e30e3e084261a9e51f81a289e7b1;hpb=4121952d2aa95c8611bf70b25b7772b5867c7666;p=clsql.git diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 14d20bc..0038da9 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -16,6 +16,10 @@ (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) @@ -97,8 +101,8 @@ (defmethod database-name-from-spec (connection-spec (database-type (eql :mysql))) (check-connection-spec connection-spec database-type (host db user password &optional port options)) - (destructuring-bind (host db user password &optional port) connection-spec - (declare (ignore password)) + (destructuring-bind (host db user password &optional port options) connection-spec + (declare (ignore password options)) (concatenate 'string (etypecase host (null "localhost") @@ -131,19 +135,27 @@ (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 + (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 - (uffi:with-foreign-string (fs value) - (mysql-options mysql-ptr option-code fs))) + (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 - (uffi:with-foreign-object (fo :unsigned-int) - (setf (uffi:deref-pointer fo :unsigned-int) value) - (mysql-options mysql-ptr option-code fo))) + (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) @@ -383,7 +395,8 @@ (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)) @@ -391,21 +404,31 @@ (unless (find col results :test #'string-equal) (push col results))))) -(defmethod database-list-attributes ((table string) (database mysql-database) - &key (owner nil)) +(defmethod database-list-attributes ((table clsql-sys::%database-identifier) + (database mysql-database) + &key (owner nil) + &aux (table (unescaped-database-identifier table))) (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) +(defmethod database-attribute-type ((attribute clsql-sys::%database-identifier) + (table clsql-sys::%database-identifier) (database mysql-database) - &key (owner nil)) + &key (owner nil) + &aux (table (unescaped-database-identifier table)) + (attribute (unescaped-database-identifier attribute))) (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)) @@ -421,17 +444,9 @@ ;;; 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)") @@ -444,7 +459,8 @@ (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) @@ -452,14 +468,14 @@ (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))) @@ -467,7 +483,7 @@ (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)))) @@ -476,9 +492,15 @@ (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) @@ -503,7 +525,8 @@ 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