Monday, August 24, 2009

Solution!

I made some adjustments to the CLSQL low-level APIs to do what I want to do. I only created the database-result-fields method for MySQL and Oracle. All other SQL databases can go screw themselves.... a.k.a. they are handled by this generic function:

db-interface.lisp

(defgeneric database-result-fields (result-set database)
(:method (result-set (database t))
(declare (ignore sql-expression))
(signal-no-database-error database))
(:method (sql-expression (database database))
(declare (ignore sql-expression))
(warn "database-result-fields not implemented for database type ~A."
(database-type database)))
(:documentation "Returns list of fieldnames and types"))


Here's the MySQL adjustment:

mysql-sql.lisp


(defmethod database-result-fields (result-set (database mysql-database))
(let ((fields '())
(field-vec (mysql-fetch-fields (mysql-result-set-res-ptr result-set))))
(dotimes (i (mysql-result-set-num-fields result-set))
(declare (fixnum 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)))
(type (uffi:get-slot-value field 'mysql-field 'type))
(type2 (uffi:get-slot-value field 'mysql-field 'mysql::flags))
)
(push (list (read-from-string name) (convert-mysql-type type type2)) fields)
)
)
(nreverse fields)
)
)

(defun convert-mysql-type (mysqltype mysqlflags)
(let ((unsigned (plusp (logand mysqlflags 32))))
(case mysqltype
((#.mysql-field-types#tiny
#.mysql-field-types#short
#.mysql-field-types#int24
#.mysql-field-types#long
#.mysql-field-types#longlong)
'integer)
((#.mysql-field-types#double
#.mysql-field-types#float
#.mysql-field-types#decimal)
'float)
(otherwise
'string))))


Surprisingly, the MySQL API is weirder. There's no actual LISP result set object. It's more of just a struct that holds all sorts of foreign-ass C bullshit (i.e. the MySQL API types.) The method is pretty simple. It takes the MySQL result set, calls the foreign function mysql-fetch-fields, which creates a C array of mysql-fields. Then it goes through and processes each one of those. The convert fields function calls this struct that matches all the data type codes to data types. Somewhat messy, but not that bad.


Oracle on the other hand....

oracle-sql.lisp

(defmethod database-result-fields ((cursor oracle-result-set) (database oracle-database))
(loop for cd across (qc-cds cursor)
collect (list
(read-from-string (cd-name cd))
(convert-oracle-type (cd-oci-data-type cd) (cd-sizeof cd)))))


(defun convert-oracle-type (oracletype sizeof)
(case oracletype
((2;;number
3;;integer
68;;unsigned int
)
'integer)
((4;;float
21;;native float
22;;native double
)
'float)
((5;;null-term string
97;;charz
)
`(string ,(- sizeof 1)))
(otherwise
`(string ,sizeof))))



...is pretty simple and elegant. Whoever built the OCI portion of CLSQL built the data structures so that they would be further removed from the UFFI crap. I like it. I also really need to learn how to use LISP loops properly.

In addition to the database-result-fields methods, I made some changes to the create-table function to allow it to handle the base clsql:sql type. I was getting pretty pissed with the constant "fell through etypecase" errors.

expressions.lisp

(defmethod output-sql ((stmt sql-create-table) database)
(flet ((output-column (column-spec)
(destructuring-bind (name type &optional db-type &rest constraints)
column-spec
(let ((type (listify type)))
(output-sql name database)
(write-char #\Space *sql-stream*)
(write-string
(if (stringp db-type) db-type ; override definition
(database-get-type-specifier (car type) (cdr type) database
(database-underlying-type database)))
*sql-stream*)
(let ((constraints (database-constraint-statement
(if (and db-type (symbolp db-type))
(cons db-type constraints)
constraints)
database)))
(when constraints
(write-string " " *sql-stream*)
(write-string constraints *sql-stream*)))))))
(with-slots (name columns modifiers transactions)
stmt
(write-string "CREATE TABLE " *sql-stream*)
(etypecase name
(string (format *sql-stream* "~s" (sql-escape name)))
(symbol (write-string (sql-escape name) *sql-stream*))
(sql-ident (output-sql name database))
(sql (output-sql name database)))
(write-string " (" *sql-stream*)
(do ((column columns (cdr column)))
((null (cdr column))
(output-column (car column)))
(output-column (car column))
(write-string ", " *sql-stream*))
(when modifiers
(do ((modifier (listify modifiers) (cdr modifier)))
((null modifier))
(write-string ", " *sql-stream*)
(write-string (car modifier) *sql-stream*)))
(write-char #\) *sql-stream*)
(when (and (eq :mysql (database-underlying-type database))
transactions
(db-type-transaction-capable? :mysql database))
(write-string " Type=InnoDB" *sql-stream*))))
t)



Anyways, I think there were some valuable lessons learned. I wouldn't say that I know clsql-sys like the back of my hand, but I am significantly more familiar with it.

Happy hacking!

No comments: