From: Kevin M. Rosenberg Date: Mon, 25 Mar 2002 14:13:41 +0000 (+0000) Subject: r1657: Auto :types implemented for mysql,postgresql X-Git-Tag: v3.8.6~1219 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=33401393ccc0a9567da4104b3c2e7608956a8624 r1657: Auto :types implemented for mysql,postgresql --- diff --git a/ChangeLog b/ChangeLog index 2bab5bf..ac948b2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +25 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net) + + * interfaces/mysql/mysql-api.cl + Added mysql-fetch-fields, mysql-fetch-field-direct + Got :auto types working + + * interfaces/postgresql/postgresql-api.cl + Added pgsql-field-types enum + Got :auto types working + +; * multiple-files +; Renamed :field-types to :types + 24 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net) * Added field-types parameter to query, database-query, diff --git a/interfaces/mysql/mysql-api.cl b/interfaces/mysql/mysql-api.cl index 2a3b911..1a91237 100644 --- a/interfaces/mysql/mysql-api.cl +++ b/interfaces/mysql/mysql-api.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: mysql-api.cl,v 1.1 2002/03/23 17:10:47 kevin Exp $ +;;;; $Id: mysql-api.cl,v 1.2 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -121,6 +121,7 @@ ;;; MYSQL-ROWS (uffi:def-array-pointer mysql-row (* :unsigned-char)) +(uffi:def-array-pointer mysql-field-vector (* mysql-field)) (uffi:def-foreign-type mysql-field-offset :unsigned-int) @@ -447,6 +448,19 @@ :module "mysql" :returning (* mysql-field)) +(declaim (inline mysql-fetch-fields)) +(uffi:def-function "mysql_fetch_fields" + ((res (* mysql-mysql-res))) + :module "mysql" + :returning mysql-field-vector) + +(declaim (inline mysql-fetch-field-direct)) +(uffi:def-function "mysql_fetch_field_direct" + ((res (* mysql-mysql-res)) + (field-num :unsigned-int)) + :module "mysql" + :returning (* mysql-field)) + (declaim (inline mysql-escape-string)) (uffi:def-function "mysql_escape_string" ((to :cstring) diff --git a/interfaces/mysql/mysql-package.cl b/interfaces/mysql/mysql-package.cl index bb737f9..666bf5d 100644 --- a/interfaces/mysql/mysql-package.cl +++ b/interfaces/mysql/mysql-package.cl @@ -7,7 +7,7 @@ ;;;; Programmers: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: mysql-package.cl,v 1.3 2002/03/24 04:37:09 kevin Exp $ +;;;; $Id: mysql-package.cl,v 1.4 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -110,6 +110,8 @@ #:mysql-fetch-row #:mysql-fetch-lengths #:mysql-fetch-field + #:mysql-fetch-fields + #:mysql-fetch-field-direct #:mysql-escape-string #:mysql-debug #:mysql-num-rows diff --git a/interfaces/mysql/mysql-sql.cl b/interfaces/mysql/mysql-sql.cl index 1850092..65f2f6f 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.7 2002/03/25 06:07:06 kevin Exp $ +;;;; $Id: mysql-sql.cl,v 1.8 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -41,14 +41,15 @@ ;;; Field conversion functions -(defun canonicalize-field-types (types num-fields) - (if (listp types) - (let ((length-types (length types)) - new-types) - (loop for i from 0 below num-fields +(defun canonicalize-field-types (types num-fields res-ptr) + (cond + ((if (listp types) + (let ((length-types (length types)) + (new-types '())) + (loop for i from 0 below num-fields do - (if (>= i length-types) - (push t new-types) ;; types is shorted than num-fields + (if (>= i length-types) + (push t new-types) ;; types is shorted than num-fields (push (case (nth i types) ((:int :long :double t) @@ -56,10 +57,33 @@ (t t)) new-types))) - (nreverse new-types)) - (if (eq types :auto) - :auto - nil))) + (nreverse new-types)))) + ((eq types :auto) + (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-test (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) + :int) + ((#.mysql-field-types#double + #.mysql-field-types#float + #.mysql-field-types#decimal) + :double) + (otherwise + t)) + new-types))) + (nreverse new-types))) + (t + nil))) (uffi:def-function "atoi" ((str :cstring)) @@ -156,7 +180,8 @@ (if res-ptr (let ((num-fields (mysql-num-fields res-ptr))) (setq field-types (canonicalize-field-types - field-types num-fields)) + field-types num-fields + res-ptr)) (unwind-protect (loop for row = (mysql-fetch-row res-ptr) until (uffi:null-pointer-p row) @@ -216,7 +241,8 @@ :full-set full-set :field-types (canonicalize-field-types - field-types num-fields)))) + field-types num-fields + res-ptr)))) (if full-set (values result-set num-fields diff --git a/interfaces/postgresql/postgresql-api.cl b/interfaces/postgresql/postgresql-api.cl index 36b093f..f2319be 100644 --- a/interfaces/postgresql/postgresql-api.cl +++ b/interfaces/postgresql/postgresql-api.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: postgresql-api.cl,v 1.2 2002/03/24 22:25:51 kevin Exp $ +;;;; $Id: postgresql-api.cl,v 1.3 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -53,6 +53,14 @@ (uffi:def-foreign-type pgsql-conn :pointer-void) (uffi:def-foreign-type pgsql-result :pointer-void) +(uffi:def-enum pgsql-ftype + ((:bytea 17) + (:int2 21) + (:int4 23) + (:float4 700) + (:float8 701))) + + ;;(declaim (inline PQsetdbLogin)) ;; causes compile error in LW 4.2.0 (uffi:def-function ("PQsetdbLogin" PQsetdbLogin) ((pghost :cstring) diff --git a/interfaces/postgresql/postgresql-package.cl b/interfaces/postgresql/postgresql-package.cl index 7991f9a..27a588e 100644 --- a/interfaces/postgresql/postgresql-package.cl +++ b/interfaces/postgresql/postgresql-package.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: postgresql-package.cl,v 1.3 2002/03/24 04:37:09 kevin Exp $ +;;;; $Id: postgresql-package.cl,v 1.4 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -39,6 +39,11 @@ #:pgsql-conn #:pgsql-result + #:pgsql-ftype#bytea + #:pgsql-ftype#int2 + #:pgsql-ftype#int4 + #:pgsql-ftype#float4 + #:pgsql-ftype#float8 ;; Functions #:PQsetdbLogin #:PQlogin diff --git a/interfaces/postgresql/postgresql-sql.cl b/interfaces/postgresql/postgresql-sql.cl index f0a1ee1..db4128b 100644 --- a/interfaces/postgresql/postgresql-sql.cl +++ b/interfaces/postgresql/postgresql-sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: postgresql-sql.cl,v 1.7 2002/03/25 06:07:06 kevin Exp $ +;;;; $Id: postgresql-sql.cl,v 1.8 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -30,14 +30,15 @@ ;;; Field conversion functions -(defun canonicalize-field-types (types num-fields) - (if (listp types) - (let ((length-types (length types)) - new-types) - (loop for i from 0 below num-fields +(defun canonicalize-field-types (types num-fields res-ptr) + (cond + ((if (listp types) + (let ((length-types (length types)) + (new-types '())) + (loop for i from 0 below num-fields do - (if (>= i length-types) - (push t new-types) ;; types is shorted than num-fields + (if (>= i length-types) + (push t new-types) ;; types is shorted than num-fields (push (case (nth i types) ((:int :long :double t) @@ -45,10 +46,28 @@ (t t)) new-types))) - (nreverse new-types)) - (if (eq types :auto) - :auto - nil))) + (nreverse new-types)))) + ((eq types :auto) + (let ((new-types '())) + (dotimes (i num-fields) + (declare (fixnum i)) + (let* ((type (PQftype res-ptr i))) + (push + (case type + ((#.pgsql-ftype#bytea + #.pgsql-ftype#int2 + #.pgsql-ftype#int4) + :int) + ((#.pgsql-ftype#float4 + #.pgsql-ftype#float8) + :double) + (otherwise + t)) + new-types))) + (nreverse new-types))) + (t + nil))) + (uffi:def-function "atoi" ((str :cstring)) @@ -165,7 +184,8 @@ (#.pgsql-exec-status-type#tuples-ok (let ((num-fields (PQnfields result))) (setq field-types - (canonicalize-field-types field-types num-fields)) + (canonicalize-field-types field-types num-fields + result)) (loop for tuple-index from 0 below (PQntuples result) collect (loop for i from 0 below num-fields @@ -242,7 +262,8 @@ :num-tuples (PQntuples result) :field-types (canonicalize-field-types field-types - (PQnfields result))))) + (PQnfields result) + result)))) (if full-set (values result-set (PQnfields result) diff --git a/test-clsql.cl b/test-clsql.cl index cbc5e92..2aed163 100644 --- a/test-clsql.cl +++ b/test-clsql.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: test-clsql.cl,v 1.5 2002/03/25 06:07:06 kevin Exp $ +;;;; $Id: test-clsql.cl,v 1.6 2002/03/25 14:13:41 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -71,7 +71,7 @@ :database db)) (pprint (clsql:map-query 'vector #'list "select * from test_clsql" :database db - :field-types '(:int :double t))) + :field-types :auto)) ;;'(:int :double t))) (clsql:execute-command "DROP TABLE test_clsql")) (clsql:disconnect :database db))) )