X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=1f54d44c430e6f261a6f7a7e509c470e035b0f79;hb=da9282a5c0ce927c613f1706f1c51796c75e16e4;hp=503da2a71ddd5f3a16150e76248f67e94ea9e6cb;hpb=80c2194145d2cd215dd94f2dc71afee14719c194;p=clsql.git diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 503da2a..1f54d44 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) @@ -155,9 +159,9 @@ (:boolean-ptr (uffi:with-foreign-object (fo :byte) (setf (uffi:deref-pointer fo :byte) - (if (or (zerop value) (null value)) - 0 - 1)) + (case value + ((nil 0) 0) + (t 1))) (mysql-options mysql-ptr option-code fo))))))))))) (defmethod database-connect (connection-spec (database-type (eql :mysql))) @@ -239,50 +243,69 @@ (defmethod database-query (query-expression (database mysql-database) result-types field-names) - (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) - (let ((mysql-ptr (database-mysql-ptr database))) - (declare (type mysql-mysql-ptr-def mysql-ptr)) + (declare (optimize (speed 3))) + (let ((mysql-ptr (database-mysql-ptr database)) + (results nil) ;; all the results and column-names in reverse-order + (res-ptr nil) + (num-fields 0)) + (declare (type mysql-mysql-ptr-def mysql-ptr) + (type (or null mysql-mysql-res-ptr-def) res-ptr) + (fixnum num-fields)) (when (database-execute-command query-expression database) - (let ((res-ptr (mysql-use-result mysql-ptr))) - (declare (type mysql-mysql-res-ptr-def res-ptr)) - (if (and res-ptr (not (uffi:null-pointer-p res-ptr))) - (unwind-protect - (let ((num-fields (mysql-num-fields res-ptr))) - (declare (fixnum num-fields)) - (setq result-types (canonicalize-types - result-types res-ptr)) - (values - (loop for row = (mysql-fetch-row res-ptr) - for lengths = (mysql-fetch-lengths res-ptr) - until (uffi:null-pointer-p row) - collect - (do* ((rlist (make-list num-fields)) - (i 0 (1+ i)) - (pos rlist (cdr pos))) - ((= i num-fields) rlist) - (declare (fixnum i)) - (setf (car pos) - (convert-raw-field - (uffi:deref-array row '(:array - (* :unsigned-char)) - 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)) - (unless (zerop (mysql-errno mysql-ptr)) - ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html - ;; if mysql_use_result or mysql_store_result return a null ptr, - ;; we use a mysql_errno check to see if it had a problem or just - ;; was a query without a result. If no error, just return nil. - (error 'sql-database-data-error - :database database - :expression query-expression - :error-id (mysql-errno mysql-ptr) - :message (mysql-error-string mysql-ptr)))))))) + (labels + ((get-row (row lengths) + "Pull a single row value from the results" + (loop for i from 0 below num-fields + collect + (convert-raw-field + (uffi:deref-array row '(:array (* :unsigned-char)) + (the fixnum i)) + (nth i result-types) + :length + (uffi:deref-array lengths '(:array :unsigned-long) + (the fixnum i)) + :encoding (encoding database)))) + (get-result-rows () + "get all the rows out of the now valid results set" + (loop for row = (mysql-fetch-row res-ptr) + for lengths = (mysql-fetch-lengths res-ptr) + until (uffi:null-pointer-p row) + collect (get-row row lengths))) + (do-result-set () + "for a mysql-ptr, grab and return a results set" + (setf res-ptr (mysql-use-result mysql-ptr)) + (cond + ((or (null res-ptr) (uffi:null-pointer-p res-ptr)) + (unless (zerop (mysql-errno mysql-ptr)) + ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html + ;; if mysql_use_result or mysql_store_result return a null ptr, + ;; we use a mysql_errno check to see if it had a problem or just + ;; was a query without a result. If no error, just return nil. + (error 'sql-database-data-error + :database database + :expression query-expression + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))) + (t + (unwind-protect + (progn (setf num-fields (mysql-num-fields res-ptr) + result-types (canonicalize-types + result-types res-ptr)) + (push (get-result-rows) results) + (push (when field-names + (result-field-names res-ptr)) + results)) + (mysql-free-result res-ptr)))))) + + (loop + do (do-result-set) + while (let ((next (mysql-next-result mysql-ptr))) + (case next + (0 t) ;Successful and there are more results + (-1 nil) ;Successful and there are no more results + (t nil) ;errors + ))) + (values-list (nreverse results)))))) (defstruct mysql-result-set @@ -295,6 +318,10 @@ (defmethod database-query-result-set ((query-expression string) (database mysql-database) &key full-set result-types) + ;; TODO: REFACTOR THIS IN TERMS OF database-query or vice-versa + ;; This doesnt seem to free database results reliably, dont think + ;; that we should allow that particularly, OTOH, dont know how + ;; we support cursoring without it (let ((mysql-ptr (database-mysql-ptr database))) (declare (type mysql-mysql-ptr-def mysql-ptr)) (when (database-execute-command query-expression database) @@ -391,7 +418,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)) @@ -399,21 +427,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)) @@ -429,17 +467,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)") @@ -452,7 +482,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) @@ -460,14 +491,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))) @@ -475,7 +506,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)))) @@ -484,7 +515,7 @@ (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)