From 5f548b417f69de4a45a29fcddf3a6e9b02519752 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 10 Nov 2005 21:53:07 +0000 Subject: [PATCH] r10813: 11 Nov 2005 Kevin Rosenberg * db-mysql/mysql-client-info.lisp: Recognize MySQL 5 * db-mysql/mysql-sql.lisp: Add support for views in MySQL 5 --- ChangeLog | 4 + db-mysql/mysql-api.lisp | 51 +++++------ db-mysql/mysql-client-info.lisp | 3 + db-mysql/mysql-sql.lisp | 149 ++++++++++++++++++-------------- 4 files changed, 116 insertions(+), 91 deletions(-) diff --git a/ChangeLog b/ChangeLog index da2f739..1c9a372 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +11 Nov 2005 Kevin Rosenberg + * db-mysql/mysql-client-info.lisp: Recognize MySQL 5 + * db-mysql/mysql-sql.lisp: Add support for views in MySQL 5 + 7 Nov 2005 Kevin Rosenberg * src/time.lisp: Apply patch from Aleksandar Bakic for ROLL function. diff --git a/db-mysql/mysql-api.lisp b/db-mysql/mysql-api.lisp index fb6bfbf..026bde0 100644 --- a/db-mysql/mysql-api.lisp +++ b/db-mysql/mysql-api.lisp @@ -4,8 +4,8 @@ ;;;; ;;;; Name: mysql-api.lisp ;;;; Purpose: Low-level MySQL interface using UFFI -;;;; Programmers: Kevin M. Rosenberg based on -;;;; Original code by Pierre R. Mai +;;;; Programmers: Kevin M. Rosenberg based on +;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; ;;;; $Id$ @@ -27,7 +27,7 @@ ;;;; that are used in a few routines. ;;;; - Removed all references to interiors of C-structions, this will ;;;; increase robustness when MySQL's internal structures change. - + ;;;; Type definitions ;;; Basic Types @@ -132,7 +132,7 @@ (decimals :unsigned-int) (type mysql-field-types)) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-struct mysql-field (name (* :char)) (org_name (* :char)) @@ -155,6 +155,7 @@ (charsetnr :unsigned-int) (type mysql-field-types)) + (uffi:def-struct mysql-time (year :unsigned-int) (month :unsigned-int) @@ -219,7 +220,7 @@ :read-default-group)) (uffi:def-enum mysql-status - (:ready + (:ready :get-result :use-result)) @@ -275,13 +276,13 @@ (handle (:struct-pointer mysql-mysql)) (eof mysql-bool)) -#+mysql-client-4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-enum mysql-field-types - (:ready + (:ready :get-result :use-result)) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-struct mysql-bind (length (* :unsigned-long)) (is-null (* mysql-bool)) @@ -305,7 +306,7 @@ (declaim (inline mysql-init)) (uffi:def-function "mysql_init" ((mysql (* mysql-mysql))) - :module "mysql" + :module "mysql" :returning (* mysql-mysql)) #-mysql-client-v4 @@ -559,16 +560,16 @@ :module "clsql-mysql" :returning :unsigned-int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-foreign-type mysql-stmt-ptr :pointer-void) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_init" ((res (* mysql-mysql-res))) :module "clsql-mysql" :returning mysql-stmt-ptr) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_prepare" ((stmt mysql-stmt-ptr) (query :cstring) @@ -576,70 +577,70 @@ :module "clsql-mysql" :returning :int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_param_count" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :unsigned-int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_bind_param" ((stmt mysql-stmt-ptr) (bind (* mysql-bind))) :module "clsql-mysql" :returning :short) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_bind_result" ((stmt mysql-stmt-ptr) (bind (* mysql-bind))) :module "clsql-mysql" :returning :short) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_result_metadata" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning (* mysql-mysql-res)) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_execute" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_store_result" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_fetch" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_free_result" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :short) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_close" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :short) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_errno" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" :returning :unsigned-int) -#+mysql-client-v4.1 +#+(or mysql-client-v4.1 mysql-client-v5) (uffi:def-function "mysql_stmt_error" ((stmt mysql-stmt-ptr)) :module "clsql-mysql" @@ -689,11 +690,11 @@ (declaim (inline mysql-num-fields)) -(uffi:def-function "mysql_num_fields" +(uffi:def-function "mysql_num_fields" ((res (* mysql-mysql-res))) :returning :unsigned-int :module "mysql") - + (declaim (inline clsql-mysql-eof)) (uffi:def-function ("mysql_eof" clsql-mysql-eof) ((res (* mysql-mysql-res))) diff --git a/db-mysql/mysql-client-info.lisp b/db-mysql/mysql-client-info.lisp index 23161ef..4124e0b 100644 --- a/db-mysql/mysql-client-info.lisp +++ b/db-mysql/mysql-client-info.lisp @@ -30,6 +30,7 @@ (setf *mysql-client-info* (uffi:convert-from-cstring (mysql-get-client-info))) + (when (and (stringp *mysql-client-info*) (plusp (length *mysql-client-info*))) (cond @@ -40,6 +41,8 @@ (when (and (>= (length *mysql-client-info*) 3) (string-equal "4.1" *mysql-client-info* :end2 3)) (pushnew :mysql-client-v4.1 cl:*features*))) + ((eql (schar *mysql-client-info* 0) #\5) + (pushnew :mysql-client-v5 cl:*features*)) (t (error "Unknown mysql client version '~A'." *mysql-client-info*))))) diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 8ead9d7..c9029ce 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -52,7 +52,7 @@ (type (uffi:get-slot-value field 'mysql-field 'type))) (push (case type - ((#.mysql-field-types#tiny + ((#.mysql-field-types#tiny #.mysql-field-types#short #.mysql-field-types#int24) (if unsigned @@ -95,7 +95,9 @@ (defclass mysql-database (database) ((mysql-ptr :accessor database-mysql-ptr :initarg :mysql-ptr - :type mysql-mysql-ptr-def))) + :type mysql-mysql-ptr-def) + (server-info :accessor database-server-info :initarg :server-info + :type string))) (defmethod database-type ((database mysql-database)) :mysql) @@ -105,12 +107,12 @@ (host db user password &optional port)) (destructuring-bind (host db user password &optional port) connection-spec (declare (ignore password)) - (concatenate 'string + (concatenate 'string (etypecase host (null "localhost") (pathname (namestring host)) (string host)) - (if port + (if port (concatenate 'string ":" (etypecase port @@ -138,8 +140,8 @@ (socket-native socket)) (let ((error-occurred nil)) (unwind-protect - (if (uffi:null-pointer-p - (mysql-real-connect + (if (uffi:null-pointer-p + (mysql-real-connect mysql-ptr host-native user-native password-native db-native (etypecase port @@ -155,11 +157,13 @@ :error-id (mysql-errno mysql-ptr) :message (mysql-error-string mysql-ptr))) (make-instance 'mysql-database - :name (database-name-from-spec connection-spec - database-type) - :database-type :mysql - :connection-spec connection-spec - :mysql-ptr mysql-ptr)) + :name (database-name-from-spec connection-spec + database-type) + :database-type :mysql + :connection-spec connection-spec + :server-info (uffi:convert-from-cstring + (mysql:mysql-get-server-info mysql-ptr)) + :mysql-ptr mysql-ptr)) (when error-occurred (mysql-close mysql-ptr))))))))) @@ -169,19 +173,19 @@ t) -(defmethod database-query (query-expression (database mysql-database) +(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))) (uffi:with-cstring (query-native query-expression) - (if (zerop (mysql-real-query mysql-ptr query-native + (if (zerop (mysql-real-query mysql-ptr query-native (expression-length query-expression))) (let ((res-ptr (mysql-use-result mysql-ptr))) (if res-ptr (unwind-protect (let ((num-fields (mysql-num-fields res-ptr))) (declare (fixnum num-fields)) - (setq result-types (canonicalize-types + (setq result-types (canonicalize-types result-types num-fields res-ptr)) (values @@ -194,7 +198,7 @@ (pos rlist (cdr pos))) ((= i num-fields) rlist) (declare (fixnum i)) - (setf (car pos) + (setf (car pos) (convert-raw-field (uffi:deref-array row '(:array (* :unsigned-char)) @@ -220,7 +224,7 @@ (uffi:with-cstring (sql-native sql-expression) (let ((mysql-ptr (database-mysql-ptr database))) (declare (type mysql-mysql-ptr-def mysql-ptr)) - (if (zerop (mysql-real-query mysql-ptr sql-native + (if (zerop (mysql-real-query mysql-ptr sql-native (expression-length sql-expression))) t (error 'sql-database-data-error @@ -230,7 +234,7 @@ :message (mysql-error-string mysql-ptr)))))) -(defstruct mysql-result-set +(defstruct mysql-result-set (res-ptr (uffi:make-null-pointer 'mysql-mysql-res) :type mysql-mysql-res-ptr-def) (types nil :type list) (num-fields 0 :type fixnum) @@ -256,9 +260,9 @@ :num-fields num-fields :full-set full-set :types - (canonicalize-types + (canonicalize-types result-types num-fields - res-ptr)))) + res-ptr)))) (if full-set (values result-set num-fields @@ -292,7 +296,7 @@ (loop for i from 0 below (mysql-result-set-num-fields result-set) for rest on list do - (setf (car rest) + (setf (car rest) (convert-raw-field (uffi:deref-array row '(:array (* :unsigned-char)) i) types @@ -305,16 +309,29 @@ (defmethod database-list-tables ((database mysql-database) &key (owner nil)) (declare (ignore owner)) - (remove-if #'(lambda (s) - (and (>= (length s) 11) - (string-equal (subseq s 0 11) "_CLSQL_SEQ_"))) - (mapcar #'car (database-query "SHOW TABLES" database nil nil)))) - -;; MySQL 4.1 does not support views + (cond + ((eql #\5 (char (database-server-info database) 0)) + (loop for (name type) in (database-query "SHOW FULL TABLES" database nil nil) + when (and (string-equal type "base table") + (not (and (>= (length name) 11) + (string-equal (subseq name 0 11) "_CLSQL_SEQ_")))) + collect name)) + (t + (remove-if #'(lambda (s) + (and (>= (length s) 11) + (string-equal (subseq s 0 11) "_CLSQL_SEQ_"))) + (mapcar #'car (database-query "SHOW TABLES" database nil nil)))))) + (defmethod database-list-views ((database mysql-database) &key (owner nil)) (declare (ignore owner)) - nil) + (cond + ((eql #\5 (char (database-server-info database) 0)) + (loop for (name type) in (database-query "SHOW FULL TABLES" database nil nil) + when (string-equal type "view") + collect name)) + (t + nil)))) (defmethod database-list-indexes ((database mysql-database) &key (owner nil)) @@ -328,7 +345,7 @@ &key (owner nil)) (declare (ignore owner)) (do ((results nil) - (rows (database-query + (rows (database-query (format nil "SHOW INDEX FROM ~A" (string-upcase table)) database nil nil) (cdr rows))) @@ -336,7 +353,7 @@ (let ((col (nth 2 (car rows)))) (unless (find col results :test #'string-equal) (push col results))))) - + (defmethod database-list-attributes ((table string) (database mysql-database) &key (owner nil)) (declare (ignore owner)) @@ -382,7 +399,7 @@ (concatenate 'string "CREATE TABLE " table-name " (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)") database) - (database-execute-command + (database-execute-command (concatenate 'string "INSERT INTO " table-name " VALUES (-1)") database))) @@ -390,7 +407,7 @@ (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)) (defmethod database-list-sequences ((database mysql-database) @@ -412,7 +429,7 @@ (defmethod database-sequence-next (sequence-name (database mysql-database)) (without-interrupts - (database-execute-command + (database-execute-command (concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name) " SET id=LAST_INSERT_ID(id+1)") database) @@ -420,8 +437,8 @@ (defmethod database-sequence-last (sequence-name (database mysql-database)) (without-interrupts - (caar (database-query - (concatenate 'string "SELECT id from " + (caar (database-query + (concatenate 'string "SELECT id from " (%sequence-name-to-table sequence-name)) database :auto nil)))) @@ -429,14 +446,14 @@ (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~@[ -P~A~] ~A" - user password + user password (if host host "localhost") port name name) (if (or (not (eql 0 status)) (and (search "failed" output) (search "error" output))) (error 'sql-database-error - :message + :message (format nil "mysql database creation failed with connection-spec ~A." connection-spec)) t)))) @@ -445,13 +462,13 @@ (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~@[ -P~A~] ~A" - user password + user password (if host host "localhost") port name) (if (or (not (eql 0 status)) (and (search "failed" output) (search "error" output))) (error 'sql-database-error - :message + :message (format nil "mysql database deletion failed with connection-spec ~A." connection-spec)) t)))) @@ -488,7 +505,7 @@ (length-ptr :initarg :length-ptr :reader length-ptr) (is-null-ptr :initarg :is-null-ptr :reader is-null-ptr) (result-types :initarg :result-types :reader result-types))) - + (defun clsql-type->mysql-type (type) (cond ((in type :null) mysql-field-types#null) @@ -499,8 +516,8 @@ ((and (consp type) (in (car type) :char :string :varchar)) mysql-field-types#var-string) ((or (eq type :blob) (and (consp type) (in (car type) :blob))) mysql-field-types#var-string) (t - (error 'sql-user-error - :message + (error 'sql-user-error + :message (format nil "Unknown clsql type ~A." type))))) #+mysql-client-v4.1 @@ -518,11 +535,11 @@ (error 'sql-database-error :error-id (mysql-errno mysql-ptr) :message (mysql-error-string mysql-ptr)))) - + (unless (= (mysql-stmt-param-count stmt) (length types)) (mysql-stmt-close stmt) (error 'sql-database-error - :message + :message (format nil "Mysql param count (~D) does not match number of types (~D)" (mysql-stmt-param-count stmt) (length types)))) @@ -534,18 +551,18 @@ #+nil (error 'sql-database-error :message "mysql_stmt_result_metadata returned NULL")) - + (let ((input-bind (uffi:allocate-foreign-object 'mysql-bind (length types))) (mysql-types (mapcar 'clsql-type->mysql-type types)) field-vec num-fields is-null-ptr output-bind length-ptr) - + (print 'a) (dotimes (i (length types)) (let* ((binding (uffi:deref-array input-bind '(:array mysql-bind) i))) - (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type) + (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type) (nth i mysql-types)) - (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0))) - + (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0))) + (print 'b) (unless (uffi:null-pointer-p rs) (setq field-vec (mysql-fetch-fields rs) @@ -559,15 +576,15 @@ (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) - + (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0) #+need-to-allocate-foreign-object-for-this - (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::is-null) + (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::is-null) (+ i (uffi:pointer-address is-null-ptr))) #+need-to-allocate-foreign-object-for-this - (setf (uffi:get-slot-value binding 'mysql-bind 'length) + (setf (uffi:get-slot-value binding 'mysql-bind 'length) (+ (* i 8) (uffi:pointer-address length-ptr))) - + (case type ((#.mysql-field-types#var-string #.mysql-field-types#string #.mysql-field-types#tiny-blob #.mysql-field-types#blob @@ -600,14 +617,14 @@ (uffi:allocate-foreign-object 'mysql-time)) (t (error "mysql type ~D not supported." type))))) - + (unless (zerop (mysql-stmt-bind-result stmt output-bind)) (mysql-stmt-close stmt) (error 'sql-database-error :error-id (mysql-stmt-errno stmt) :message (uffi:convert-from-cstring (mysql-stmt-error stmt))))) - + (make-instance 'mysql-stmt :database database :stmt stmt @@ -674,7 +691,7 @@ (push (loop for i from 0 below num-fields collect - (let ((is-null + (let ((is-null (not (zerop (uffi:ensure-char-integer (uffi:deref-array (is-null-ptr stmt) '(:array :byte) i)))))) (unless is-null @@ -714,10 +731,10 @@ (t (list type))))))) rows))) - - - + + + #+mysql-client-v4.1 (defmethod database-free-prepared ((stmt mysql-stmt)) (with-slots (stmt) stmt @@ -731,16 +748,16 @@ t) (defmethod db-type-has-views? ((db-type (eql :mysql))) - #+mysql-client-v5.1 t - #-mysql-client-v5.1 nil) + #+mysql-client-v5 t + #-mysql-client-v5 nil) (defmethod db-type-has-subqueries? ((db-type (eql :mysql))) - #+mysql-client-v4.1 t - #-mysql-client-v4.1 nil) + #+(or mysql-client-v4.1 mysql-client-v5) t + #-(or mysql-client-v4.1 mysql-client-v5) nil) (defmethod db-type-has-boolean-where? ((db-type (eql :mysql))) - #+mysql-client-v4.1 t - #-mysql-client-v4.1 nil) + #+(or mysql-client-v4.1 mysql-client-v5) t + #-(or mysql-client-v4.1 mysql-client-v5) nil) (defmethod db-type-has-union? ((db-type (eql :mysql))) (not (eql (schar mysql::*mysql-client-info* 0) #\3))) @@ -750,8 +767,8 @@ (and tuple (string-equal "YES" (second tuple))))) (defmethod db-type-has-prepared-stmt? ((db-type (eql :mysql))) - #+mysql-client-v4.1 t - #-mysql-client-v4.1 nil) + #+(or mysql-client-v4.1 mysql-client-v5) t + #-(or mysql-client-v4.1 mysql-client-v5) nil) (when (clsql-sys:database-type-library-loaded :mysql) (clsql-sys:initialize-database-type :database-type :mysql)) -- 2.34.1