X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=interfaces%2Fmysql%2Fmysql-sql.cl;h=264c71b51fff17fed48baa4221db803fe031c946;hb=f8478421f5a0440246f70aa4234ff25f416be7e3;hp=ad22f9d79b8854b3bcb38974d27a18a078480227;hpb=d9e609eddd22c1f837d9b030ebc15b0f40ddf5f0;p=clsql.git diff --git a/interfaces/mysql/mysql-sql.cl b/interfaces/mysql/mysql-sql.cl index ad22f9d..264c71b 100644 --- a/interfaces/mysql/mysql-sql.cl +++ b/interfaces/mysql/mysql-sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: mysql-sql.cl,v 1.5 2002/03/24 18:39:32 kevin Exp $ +;;;; $Id: mysql-sql.cl,v 1.19 2002/04/27 20:58:11 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -33,12 +33,52 @@ ;;;; Added field types (defpackage :clsql-mysql - (:use :common-lisp :clsql-sys :mysql) + (:use :common-lisp :clsql-sys :mysql :clsql-uffi) (:export #:mysql-database) (:documentation "This is the CLSQL interface to MySQL.")) (in-package :clsql-mysql) +;;; Field conversion functions + +(defun make-type-list-for-auto (num-fields res-ptr) + (let ((new-types '()) + #+ignore (field-vec (mysql-fetch-fields res-ptr))) + (dotimes (i num-fields) + (declare (fixnum i)) + (let* ( (field (mysql-fetch-field-direct res-ptr i)) + #+ignore (field (uffi:deref-array field-vec 'mysql-field-vector i)) + (type (uffi:get-slot-value field 'mysql-field 'type))) + (push + (case type + ((#.mysql-field-types#tiny + #.mysql-field-types#short + #.mysql-field-types#int24 + #.mysql-field-types#long) + :int32) + (#.mysql-field-types#longlong + :int64) + ((#.mysql-field-types#double + #.mysql-field-types#float + #.mysql-field-types#decimal) + :double) + (otherwise + t)) + new-types))) + (nreverse new-types))) + +(defun canonicalize-types (types num-fields res-ptr) + (if (null types) + nil + (let ((auto-list (make-type-list-for-auto num-fields res-ptr))) + (cond + ((listp types) + (canonicalize-type-list types auto-list)) + ((eq types :auto) + auto-list) + (t + nil))))) + (defmethod database-initialize-database-type ((database-type (eql :mysql))) t) @@ -50,12 +90,16 @@ ((mysql-ptr :accessor database-mysql-ptr :initarg :mysql-ptr :type mysql-mysql-ptr-def))) +(defmethod database-type ((database mysql-database)) + :mysql) + (defmethod database-name-from-spec (connection-spec (database-type (eql :mysql))) (check-connection-spec connection-spec database-type (host db user password)) (destructuring-bind (host db user password) connection-spec (declare (ignore password)) (concatenate 'string host "/" db "/" user))) + (defmethod database-connect (connection-spec (database-type (eql :mysql))) (check-connection-spec connection-spec database-type (host db user password)) (destructuring-bind (host db user password) connection-spec @@ -88,6 +132,7 @@ (make-instance 'mysql-database :name (database-name-from-spec connection-spec database-type) + :connection-spec connection-spec :mysql-ptr mysql-ptr)) (when error-occurred (mysql-close mysql-ptr))))))))) @@ -98,61 +143,27 @@ t) -(defstruct mysql-result-set - (res-ptr (uffi:make-null-pointer 'mysql-mysql-res) - :type mysql-mysql-res-ptr-def) - (field-types nil :type cons) - (full-set nil :type boolean)) - -(defmethod database-dump-result-set (result-set (database mysql-database)) - (mysql-free-result (mysql-result-set-res-ptr result-set)) - t) - - -(defmethod database-store-next-row (result-set (database mysql-database) list) - (let* ((res-ptr (mysql-result-set-res-ptr result-set)) - (row (mysql-fetch-row res-ptr))) - (declare (type mysql-mysql-res-ptr-def res-ptr) - (type mysql-row-def row)) - (unless (uffi:null-pointer-p row) - (loop for i from 0 below (mysql-num-fields res-ptr) - for rest on list - do - (setf (car rest) - (uffi:convert-from-foreign-string (uffi:deref-array row 'mysql-row i)))) - list))) - - -(defmethod database-execute-command (sql-expression (database mysql-database)) - (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-query mysql-ptr sql-native)) - t - (error 'clsql-sql-error - :database database - :expression sql-expression - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)))))) - - - (defmethod database-query (query-expression (database mysql-database) - field-types) + types) (with-slots (mysql-ptr) database (uffi:with-cstring (query-native query-expression) (if (zerop (mysql-query mysql-ptr query-native)) (let ((res-ptr (mysql-use-result mysql-ptr))) (if res-ptr - (unwind-protect - (loop for row = (mysql-fetch-row res-ptr) - until (uffi:null-pointer-p row) - collect - (loop for i from 0 below (mysql-num-fields res-ptr) - collect - (uffi:convert-from-cstring - (uffi:deref-array row 'mysql-row i)))) - (mysql-free-result res-ptr)) + (let ((num-fields (mysql-num-fields res-ptr))) + (setq types (canonicalize-types + types num-fields + res-ptr)) + (unwind-protect + (loop for row = (mysql-fetch-row res-ptr) + until (uffi:null-pointer-p row) + collect + (loop for i from 0 below num-fields + collect + (convert-raw-field + (uffi:deref-array row 'mysql-row i) + types i))) + (mysql-free-result res-ptr))) (error 'clsql-sql-error :database database :expression query-expression @@ -164,9 +175,29 @@ :errno (mysql-errno mysql-ptr) :error (mysql-error-string mysql-ptr)))))) +(defmethod database-execute-command (sql-expression (database mysql-database)) + (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-query mysql-ptr sql-native)) + t + (error 'clsql-sql-error + :database database + :expression sql-expression + :errno (mysql-errno mysql-ptr) + :error (mysql-error-string mysql-ptr)))))) + +(defstruct mysql-result-set + (res-ptr (uffi:make-null-pointer 'mysql-mysql-res) + :type mysql-mysql-res-ptr-def) + (types nil) + (num-fields nil :type fixnum) + (full-set nil :type boolean)) + -(defmethod database-query-result-set (query-expression (database mysql-database) - &key full-set field-types) +(defmethod database-query-result-set (query-expression + (database mysql-database) + &key full-set types) (uffi:with-cstring (query-native query-expression) (let ((mysql-ptr (database-mysql-ptr database))) (declare (type mysql-mysql-ptr-def mysql-ptr)) @@ -176,14 +207,22 @@ (mysql-use-result mysql-ptr)))) (declare (type mysql-mysql-res-ptr-def res-ptr)) (if (not (uffi:null-pointer-p res-ptr)) - (if full-set - (values (make-mysql-result-set :res-ptr res-ptr :full-set t - :field-types field-types) - (mysql-num-fields res-ptr) - (mysql-num-rows res-ptr)) - (values (make-mysql-result-set :res-ptr res-ptr) - (mysql-num-fields res-ptr))) - (error 'clsql-sql-error + (let* ((num-fields (mysql-num-fields res-ptr)) + (result-set (make-mysql-result-set + :res-ptr res-ptr + :num-fields num-fields + :full-set full-set + :types + (canonicalize-types + types num-fields + res-ptr)))) + (if full-set + (values result-set + num-fields + (mysql-num-rows res-ptr)) + (values result-set + num-fields))) + (error 'clsql-sql-error :database database :expression query-expression :errno (mysql-errno mysql-ptr) @@ -194,4 +233,26 @@ :errno (mysql-errno mysql-ptr) :error (mysql-error-string mysql-ptr)))))) +(defmethod database-dump-result-set (result-set (database mysql-database)) + (mysql-free-result (mysql-result-set-res-ptr result-set)) + t) + + +(defmethod database-store-next-row (result-set (database mysql-database) list) + (let* ((res-ptr (mysql-result-set-res-ptr result-set)) + (row (mysql-fetch-row res-ptr)) + (types (mysql-result-set-types result-set))) + (declare (type mysql-mysql-res-ptr-def res-ptr) + (type mysql-row-def row)) + (unless (uffi:null-pointer-p row) + (loop for i from 0 below (mysql-result-set-num-fields result-set) + for rest on list + do + (setf (car rest) + (convert-raw-field + (uffi:deref-array row 'mysql-row i) + types + i))) + list))) +