;;;; *************************************************************************
(defpackage #:clsql-mysql
- (:use #:common-lisp #:clsql-base-sys #:mysql #:clsql-uffi)
+ (:use #:common-lisp #:clsql-base #:mysql #:clsql-uffi)
(:export #:mysql-database)
(:documentation "This is the CLSQL interface to MySQL."))
(field-vec (mysql-fetch-fields res-ptr)))
(dotimes (i num-fields)
(declare (fixnum i))
- (let* ((field (uffi:deref-array field-vec '(:array (* mysql-field)) i))
+ (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
(name (uffi:convert-from-foreign-string
(uffi:get-slot-value field 'mysql-field 'mysql::name))))
(push name names)))
(field-vec (mysql-fetch-fields res-ptr)))
(dotimes (i num-fields)
(declare (fixnum i))
- (let* ((field (uffi:deref-array field-vec '(:array (* mysql-field)) i))
+ (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
(type (uffi:get-slot-value field 'mysql-field 'type)))
(push
(case type
(do ((results nil)
(rows (database-query
(format nil "SHOW INDEX FROM ~A" (string-upcase table))
- database nil)
+ database nil nil)
(cdr rows)))
((null rows) (nreverse results))
(let ((col (nth 2 (car rows))))
(mapcar #'car
(database-query
(format nil "SHOW COLUMNS FROM ~A" table)
- database nil)))
+ database nil nil)))
(defmethod database-attribute-type (attribute (table string)
(database mysql-database)
&key (owner nil))
(declare (ignore owner))
- (let ((result
- (mapcar #'cadr
- (database-query
- (format nil
- "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
- database nil))))
- (let* ((str (car result))
- (end-str (position #\( str))
- (substr (subseq str 0 end-str)))
- (if substr
- (intern (string-upcase substr) :keyword) nil))))
+ (let ((row (car (database-query
+ (format nil
+ "SHOW COLUMNS FROM ~A LIKE '~A'" table attribute)
+ database nil nil))))
+ (let* ((raw-type (second row))
+ (null (third row))
+ (start-length (position #\( raw-type))
+ (type (if start-length
+ (subseq raw-type 0 start-length)
+ raw-type))
+ (length (when start-length
+ (parse-integer (subseq raw-type (1+ start-length))
+ :junk-allowed t))))
+ (when type
+ (values (ensure-keyword type) length nil (if (string-equal null "YES") 1 0))))))
;;; Sequence functions
(defmethod database-create (connection-spec (type (eql :mysql)))
(destructuring-bind (host name user password) connection-spec
(multiple-value-bind (output status)
- (clsql-base-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A"
+ (clsql-base:command-output "mysqladmin create -u~A -p~A -h~A ~A"
user password
(if host host "localhost")
name)
(defmethod database-destroy (connection-spec (type (eql :mysql)))
(destructuring-bind (host name user password) connection-spec
(multiple-value-bind (output status)
- (clsql-base-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
+ (clsql-base:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
user password
(if host host "localhost")
name)
(let ((database (database-connect (list host "mysql" user password) type)))
(unwind-protect
(progn
- (setf (slot-value database 'clsql-base-sys::state) :open)
+ (setf (slot-value database 'clsql-base::state) :open)
(mapcar #'car (database-query "show databases" database :auto nil)))
(progn
(database-disconnect database)
- (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+ (setf (slot-value database 'clsql-base::state) :closed))))))
;;; Database capabilities
(let ((tuple (car (database-query "SHOW VARIABLES LIKE 'HAVE_INNODB'" database :auto nil))))
(and tuple (string-equal "YES" (second tuple)))))
-(when (clsql-base-sys:database-type-library-loaded :mysql)
- (clsql-base-sys:initialize-database-type :database-type :mysql))
+(when (clsql-base:database-type-library-loaded :mysql)
+ (clsql-base:initialize-database-type :database-type :mysql))