X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-odbc%2Fodbc-dbi.lisp;h=634a43e2601f101cc9b19e51d6aea0be108925a5;hp=6d62f3dc663b3cf938dd13351a276031fac0cc01;hb=5148be446aee32ec705beac3fbba35f499df4fd4;hpb=a7e38685365a6cf067290843c0ed168b6fb545e9 diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index 6d62f3d..634a43e 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Create: April 2004 ;;;; -;;;; $Id: odbc-sql.lisp 8983 2004-04-12 21:16:48Z kevin $ +;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -30,8 +30,10 @@ #:disconnect #:end-transaction #:fetch-row + #:list-all-data-sources #:list-all-database-tables #:list-all-table-columns + #:list-table-indexes #:loop-over-results #:prepare-sql #:rr-sql @@ -48,10 +50,30 @@ (in-package #:odbc-dbi) +(defgeneric terminate (src)) +(defgeneric db-open-query (src query-expression + &key arglen col-positions result-types width + &allow-other-keys)) +(defgeneric db-fetch-query-results (src &optional count)) +(defgeneric %db-execute (src sql-expression &key &allow-other-keys)) +(defgeneric db-execute-command (src sql-string)) + +(defgeneric %initialize-query (src arglen col-positions + &key result-types width)) + +(defgeneric %read-query-data (src ignore-columns)) +(defgeneric db-map-query (src type function query-exp &key result-types)) +(defgeneric db-prepare-statement (src sql &key parameter-table + parameter-columns)) +(defgeneric get-odbc-info (src info-type)) + + ;;; SQL Interface (defclass odbc-db () (;; any reason to have more than one henv? + (width :initform +max-precision+ :accessor db-width) + (hstmt :initform nil :accessor db-hstmt) (henv :initform nil :allocation :class :initarg :henv :accessor henv) (hdbc :initform nil :initarg :hdbc :accessor hdbc) ;; info returned from SQLGetInfo @@ -67,8 +89,10 @@ ;; resource of (active and inactive) query objects (queries :initform () :accessor db-queries))) -(defclass query () +(defclass odbc-query () ((hstmt :initform nil :initarg :hstmt :accessor hstmt) ; = cursor?? + (width :initform +max-precision+ :accessor query-width) + (computed-result-types :initform nil :initarg :computed-result-types :accessor computed-result-types) (column-count :initform nil :accessor column-count) (column-names :initform (make-array 0 :element-type 'string :adjustable t :fill-pointer t) :accessor column-names) @@ -98,13 +122,15 @@ "Stores query information, like SQL query string/expression and database to run the query against." )) +;;; AODBC Compatible interface + (defun connect (&key data-source-name user password (autocommit t)) (let ((db (make-instance 'odbc-db))) (unless (henv db) ;; has class allocation! (setf (henv db) (%new-environment-handle))) (setf (hdbc db) (%new-db-connection-handle (henv db))) (%sql-connect (hdbc db) data-source-name user password) - ;; FIXME: Check if connected + #+ignore (setf (db-hstmt db) (%new-statement-handle (hdbc db))) (when (/= (get-odbc-info db odbc::$SQL_TXN_CAPABLE) odbc::$SQL_TC_NONE) (if autocommit (enable-autocommit (hdbc db)) @@ -119,48 +145,99 @@ the query against." )) (when hstmt (%free-statement hstmt :drop) (setf hstmt nil))))) + (when (db-hstmt database) + (%free-statement (db-hstmt database) :drop)) (%disconnect hdbc))) -(defun sql (expr &key db result-types row-count column-names) - (warn "Not implemented.")) +(defun sql (expr &key db result-types row-count (column-names t) query + hstmt width) + (declare (ignore hstmt)) + (cond + (query + (let ((q (db-open-query db expr :result-types result-types :width width))) + (if column-names + (values q (column-names q)) + q))) + (t + (multiple-value-bind (data col-names) + (db-query db expr :result-types result-types :width width) + (cond + (row-count + (if (consp data) (length data) data)) + (column-names + (values data col-names)) + (t + data)))))) + +(defun fetch-row (query &optional (eof-errorp t) eof-value) + (multiple-value-bind (row query count) (db-fetch-query-results query 1) + (cond + ((zerop count) + (close-query query) + (when eof-errorp + (error 'clsql:sql-database-data-error + :message "ODBC: Ran out of data in fetch-row")) + eof-value) + (t + (car row))))) + + +(defun close-query (query) + (db-close-query query)) + +(defun list-all-database-tables (&key db hstmt) + (declare (ignore hstmt)) + (let ((query (get-free-query db))) + (unwind-protect + (progn + (with-slots (hstmt) query + (unless hstmt (setf hstmt (%new-statement-handle (hdbc db)))) + (%list-tables hstmt) + (%initialize-query query nil nil) + (values + (db-fetch-query-results query) + (coerce (column-names query) 'list)))) + (db-close-query query)))) + +(defun list-table-indexes (table &key db unique hstmt) + (declare (ignore hstmt)) + (let ((query (get-free-query db))) + (unwind-protect + (progn + (with-slots (hstmt) query + (unless hstmt + (setf hstmt (%new-statement-handle (hdbc db)))) + (%table-statistics table hstmt :unique unique) + (%initialize-query query nil nil) + (values + (db-fetch-query-results query) + (coerce (column-names query) 'list)))) + (db-close-query query)))) + +(defun list-all-table-columns (table &key db hstmt) + (declare (ignore hstmt)) + (db-describe-columns db "" "" table "")) + +(defun list-all-data-sources () + (let ((db (make-instance 'odbc-db))) + (unless (henv db) ;; has class allocation! + (setf (henv db) (%new-environment-handle))) + (%list-data-sources (henv db)))) -(defun close-query (result-set) - (warn "Not implemented.")) +(defun rr-sql (hstmt sql-statement &key db) + (declare (ignore hstmt sql-statement db)) + (warn "rr-sql not implemented.")) -(defun fetch-row (result-set error-eof eof-value) - (warn "Not implemented.")) +;;; Mid-level interface -(defclass odbc-query (query) - ((hstmt :initform nil :initarg :hstmt :accessor hstmt) ; = cursor?? - (column-count :initform nil :accessor column-count) - (column-names :initform (make-array 0 :element-type 'string :adjustable t :fill-pointer t) - :accessor column-names) - (column-c-types :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t) - :accessor column-c-types) - (column-sql-types :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t) - :accessor column-sql-types) - (column-data-ptrs :initform (make-array 0 :adjustable t :fill-pointer t) - :accessor data-ptrs) - (column-out-len-ptrs :initform (make-array 0 :adjustable t :fill-pointer t) - :accessor column-out-len-ptrs) - (column-precisions :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t) - :accessor column-precisions) - (column-scales :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t) - :accessor column-scales) - (column-nullables-p :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t) - :accessor column-nullables-p) - ;;(parameter-count :initform 0 :accessor parameter-count) - (parameter-data-ptrs :initform (make-array 0 :adjustable t :fill-pointer t) - :accessor parameter-ptrs))) - -(defmethod db-commit ((database odbc-db)) +(defun db-commit (database) (%commit (henv database) (hdbc database))) -(defmethod db-rollback ((database odbc-db)) +(defun db-rollback (database) (%rollback (henv database) (hdbc database))) -(defmethod db-cancel-query ((query odbc-query)) +(defun db-cancel-query (query) (with-slots (hstmt) query (%sql-cancel hstmt) (setf (query-active-p query) nil))) @@ -181,7 +258,7 @@ the query against." )) column-out-len-ptrs column-precisions column-scales column-nullables-p active-p) query (setf (hstmt query) hstmt) - (%initialize-query query) + (%initialize-query query nil nil) (setf active-p t))))) ;; one for odbc-db is missing @@ -193,7 +270,7 @@ the query against." )) (uffi:free-foreign-object hstmt)) ;; ?? (%dispose-column-ptrs query))) -(defmethod %dispose-column-ptrs ((query odbc-query)) +(defun %dispose-column-ptrs (query) (with-slots (column-data-ptrs column-out-len-ptrs hstmt) query (loop for data-ptr across column-data-ptrs when data-ptr do (uffi:free-foreign-object data-ptr)) @@ -201,141 +278,102 @@ the query against." )) when out-len-ptr do (uffi:free-foreign-object out-len-ptr)))) (defmethod db-open-query ((database odbc-db) query-expression - &key arglen col-positions - &allow-other-keys) + &key arglen col-positions result-types width + &allow-other-keys) (db-open-query (get-free-query database) query-expression - :arglen arglen :col-positions col-positions)) + :arglen arglen :col-positions col-positions + :result-types result-types + :width (if width width (db-width database)))) (defmethod db-open-query ((query odbc-query) query-expression - &key arglen col-positions &allow-other-keys) + &key arglen col-positions result-types width + &allow-other-keys) (%db-execute query query-expression) - (%initialize-query query arglen col-positions)) + (%initialize-query query arglen col-positions :result-types result-types + :width width)) -(defmethod db-fetch-query-results ((database odbc-db) &optional count flatp) - (db-fetch-query-results (db-query-object database) count flatp)) +(defmethod db-fetch-query-results ((database odbc-db) &optional count) + (db-fetch-query-results (db-query-object database) count)) -(defmethod db-fetch-query-results ((query odbc-query) &optional count flatp) +(defmethod db-fetch-query-results ((query odbc-query) &optional count) (when (query-active-p query) - (let (#+ignore(no-data nil)) - (with-slots (column-count column-data-ptrs column-c-types column-sql-types - column-out-len-ptrs column-precisions hstmt) - query - (values - (cond (flatp - (when (> column-count 1) - (error "If more than one column is to be fetched, flatp has to be nil.")) - (let ((data-ptr (aref column-data-ptrs 0)) - (c-type (aref column-c-types 0)) - (sql-type (aref column-sql-types 0)) - (out-len-ptr (aref column-out-len-ptrs 0)) - (precision (aref column-precisions 0))) - (loop for i from 0 - until (or (and count (= i count)) - ;;(setf no-data ;; not used??? - (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND)) - collect - (cond ((< 0 precision +max-precision+) - (read-data data-ptr c-type sql-type out-len-ptr nil)) - ((zerop (get-cast-long out-len-ptr)) - nil) - (t - (read-data-in-chunks hstmt 0 data-ptr c-type sql-type - out-len-ptr nil))) - #+ignore - (if (< 0 precision +max-precision+) ;(and precision (< precision +max-precision+)) - (read-data data-ptr c-type sql-type out-len-ptr nil) - (read-data-in-chunks hstmt 0 data-ptr c-type sql-type - out-len-ptr nil))))) - (t - (loop for i from 0 - until (or (and count (= i count)) - (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND)) - collect - (loop for data-ptr across column-data-ptrs - for c-type across column-c-types - for sql-type across column-sql-types - for out-len-ptr across column-out-len-ptrs - for precision across column-precisions - for j from 0 ; column count is zero based in lisp - collect - (cond ((< 0 precision +max-precision+) - (read-data data-ptr c-type sql-type out-len-ptr nil)) - ((zerop (get-cast-long out-len-ptr)) - nil) - (t - (read-data-in-chunks hstmt j data-ptr c-type sql-type - out-len-ptr nil))))))) - query))))) - -#+lispworks -(defmacro without-interrupts (&body body) - `(mp:without-preemption ,@body)) - -#+allegro -(defmacro without-interrupts (&body body) - `(mp:without-scheduling ,@body)) - -#+cormanlisp -(defmacro without-interrupts (&body body) - `(progn ,@body)) - -#+pcl -(defmacro without-interrupts (&body body) - `(pcl::without-interrupts ,@body)) - -(defmethod db-query ((database odbc-db) query-expression &optional flatp) - (let ((free-query - ;; make it thread safe - (get-free-query database))) - ;;(format tb::*local-output* "~%new query: ~s" free-query) + (with-slots (column-count column-data-ptrs column-c-types column-sql-types + column-out-len-ptrs column-precisions hstmt computed-result-types) + query + (let* ((rows-fetched 0) + (rows + (loop for i from 0 + until (or (and count (= i count)) + (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND)) + collect + (loop for result-type across computed-result-types + for data-ptr across column-data-ptrs + for c-type across column-c-types + for sql-type across column-sql-types + for out-len-ptr across column-out-len-ptrs + for precision across column-precisions + for j from 0 ; column count is zero based in lisp + collect + (progn + (incf rows-fetched) + (cond ((< 0 precision (query-width query)) + (read-data data-ptr c-type sql-type out-len-ptr result-type)) + ((zerop (get-cast-long out-len-ptr)) + nil) + (t + (read-data-in-chunks hstmt j data-ptr c-type sql-type + out-len-ptr result-type)))))))) + (values rows query rows-fetched))))) + +(defun db-query (database query-expression &key result-types width) + (let ((free-query (get-free-query database))) (setf (sql-expression free-query) query-expression) (unwind-protect (progn (%db-execute free-query query-expression) - (%initialize-query free-query) - (values - (db-fetch-query-results free-query nil flatp) - ;; LMH return the column names as well - (column-names free-query))) + (%initialize-query free-query nil nil :result-types result-types :width width) + (if (plusp (column-count free-query)) ;; KMR: Added check for commands that don't return columns + (values + (db-fetch-query-results free-query nil) + (map 'list #'identity (column-names free-query))) + (values + (result-rows-count (hstmt free-query)) + nil))) (db-close-query free-query) - ;;(format tb::*local-output* "~%query closed: ~s" free-query) ))) (defmethod %db-execute ((database odbc-db) sql-expression &key &allow-other-keys) (%db-execute (get-free-query database) sql-expression)) -;; C. Stacy's idea (defmethod %db-execute ((query odbc-query) sql-expression &key &allow-other-keys) - ;; cstacy - (when *trace-sql* - (format (if (streamp *trace-sql*) *trace-sql* *trace-output*) - "~&~A;~%" sql-expression)) (with-slots (henv hdbc) (odbc::query-database query) (with-slots (hstmt) query (unless hstmt (setf hstmt (%new-statement-handle hdbc))) - ;;(print (list :new hstmt) tb::*local-output*) (setf (sql-expression query) sql-expression) (%sql-exec-direct sql-expression hstmt henv hdbc) query))) ;; reuse inactive queries -(defmethod get-free-query ((database odbc-db)) +(defun get-free-query (database) "get-free-query finds or makes a nonactive query object, and then sets it to active. This makes the functions db-execute-command and db-query thread safe." - (with-slots (queries) database - (or (without-interrupts ;; not context switch allowed here + (with-slots (queries hdbc) database + (or (clsql-sys:without-interrupts (let ((inactive-query (find-if (lambda (query) (not (query-active-p query))) queries))) (when inactive-query (with-slots (column-count column-names column-c-types - column-sql-types column-data-ptrs - column-out-len-ptrs column-precisions - column-scales column-nullables-p) + width hstmt + column-sql-types column-data-ptrs + column-out-len-ptrs column-precisions + column-scales column-nullables-p) inactive-query ;;(print column-data-ptrs tb::*local-output*) ;;(%dispose-column-ptrs inactive-query) (setf column-count 0 + width +max-precision+ + ;; KMR hstmt (%new-statement-handle hdbc) (fill-pointer column-names) 0 (fill-pointer column-c-types) 0 (fill-pointer column-sql-types) 0 @@ -357,10 +395,6 @@ This makes the functions db-execute-command and db-query thread safe." (db-execute-command (get-free-query database) sql-string)) (defmethod db-execute-command ((query odbc-query) sql-string) - ;; cstacy - (when *trace-sql* - (format (if (streamp *trace-sql*) *trace-sql* *trace-output*) - "~&~A;~%" sql-string)) (with-slots (hstmt database) query (with-slots (henv hdbc) database (unless hstmt (setf hstmt (%new-statement-handle hdbc))) @@ -368,18 +402,21 @@ This makes the functions db-execute-command and db-query thread safe." (%sql-exec-direct sql-string hstmt henv hdbc) (db-close-query query))))) -(defmethod %initialize-query ((database odbc-db) &optional arglen col-positions) - (%initialize-query (db-query-object database) arglen col-positions)) +(defmethod %initialize-query ((database odbc-db) arglen col-positions &key result-types width) + (%initialize-query (db-query-object database) arglen col-positions + :result-types result-types + :width (if width width (db-width database)))) -(defmethod %initialize-query ((query odbc-query) &optional arglen col-positions) - (with-slots (hstmt +(defmethod %initialize-query ((query odbc-query) arglen col-positions &key result-types width) + (with-slots (hstmt computed-result-types column-count column-names column-c-types column-sql-types column-data-ptrs column-out-len-ptrs column-precisions column-scales column-nullables-p) - query + query (setf column-count (if arglen (min arglen (result-columns-count hstmt)) (result-columns-count hstmt))) + (when width (setf (query-width query) width)) ;;(format tb::*local-output* "~%column-count: ~d, col-positions: ~d" column-count col-positions) (labels ((initialize-column (col-nr) (multiple-value-bind (name sql-type precision scale nullable-p) @@ -402,10 +439,30 @@ This makes the functions db-execute-command and db-query thread safe." (initialize-column col-nr)) (dotimes (col-nr column-count) ;; get column information - (initialize-column col-nr))))) + (initialize-column col-nr)))) + + (setf computed-result-types (make-array column-count)) + (dotimes (i column-count) + (setf (aref computed-result-types i) + (cond + ((consp result-types) + (nth i result-types)) + ((eq result-types :auto) + (if (eq (aref column-sql-types i) odbc::$SQL_BIGINT) + :number + (case (aref column-c-types i) + (#.odbc::$SQL_C_SLONG :int) + (#.odbc::$SQL_C_DOUBLE :double) + (#.odbc::$SQL_C_FLOAT :float) + (#.odbc::$SQL_C_SSHORT :short) + (#.odbc::$SQL_C_STINYINT :short) + (#.odbc::$SQL_BIGINT :short) + (t t)))) + (t + t))))) query) -(defmethod db-close-query ((query odbc-query) &key drop-p) +(defun db-close-query (query &key drop-p) (with-slots (hstmt column-count column-names column-c-types column-sql-types column-data-ptrs column-out-len-ptrs column-precisions column-scales column-nullables-p) query @@ -414,8 +471,10 @@ This makes the functions db-execute-command and db-query thread safe." (dotimes (col-nr count) (let ((data-ptr (aref column-data-ptrs col-nr)) (out-len-ptr (aref column-out-len-ptrs col-nr))) - (when data-ptr (uffi:free-foreign-object data-ptr)) ; we *did* allocate them - (when out-len-ptr (uffi:free-foreign-object out-len-ptr))))) + (declare (ignorable data-ptr out-len-ptr)) + ;; free-statment :unbind frees these + #+ignore (when data-ptr (uffi:free-foreign-object data-ptr)) + #+ignore (when out-len-ptr (uffi:free-foreign-object out-len-ptr))))) (cond ((null hstmt) nil) (drop-p @@ -432,23 +491,25 @@ This makes the functions db-execute-command and db-query thread safe." (%read-query-data (db-query-object database) ignore-columns)) (defmethod %read-query-data ((query odbc-query) ignore-columns) - (with-slots (hstmt column-count column-c-types column-sql-types - column-data-ptrs column-out-len-ptrs column-precisions) - query - (unless (= (SQLFetch hstmt) odbc::$SQL_NO_DATA_FOUND) + (with-slots (hstmt column-count column-c-types column-sql-types + column-data-ptrs column-out-len-ptrs column-precisions + computed-result-types) + query + (unless (= (odbc::SQLFetch hstmt) odbc::$SQL_NO_DATA_FOUND) (values (loop for col-nr from 0 to (- column-count (if (eq ignore-columns :last) 2 1)) - collect + for result-type across computed-result-types + collect (let ((precision (aref column-precisions col-nr)) (sql-type (aref column-sql-types col-nr))) - (cond ((or (< 0 precision +max-precision+) + (cond ((or (< 0 precision (query-width query)) (and (zerop precision) (not (find sql-type '($SQL_C_CHAR))))) (read-data (aref column-data-ptrs col-nr) (aref column-c-types col-nr) sql-type (aref column-out-len-ptrs col-nr) - nil)) + result-type)) ((zerop (get-cast-long (aref column-out-len-ptrs col-nr))) *null*) (t @@ -457,18 +518,18 @@ This makes the functions db-execute-command and db-query thread safe." (aref column-c-types col-nr) (aref column-sql-types col-nr) (aref column-out-len-ptrs col-nr) - nil))))) + result-type))))) t)))) -(defmethod db-map-query ((database odbc-db) type function query-exp) - (db-map-query (get-free-query database) type function query-exp)) +(defmethod db-map-query ((database odbc-db) type function query-exp &key result-types) + (db-map-query (get-free-query database) type function query-exp :result-types result-types)) -(defmethod db-map-query ((query odbc-query) type function query-exp) +(defmethod db-map-query ((query odbc-query) type function query-exp &key result-types) (declare (ignore type)) ; preliminary. Do a type coersion here (%db-execute query (sql-expression query-exp)) (unwind-protect (progn - (%initialize-query query) + (%initialize-query query nil nil :result-types result-types) ;; the main loop (loop for data = (%read-query-data query nil) while data @@ -476,8 +537,8 @@ This makes the functions db-execute-command and db-query thread safe." ;; dispose of memory and set query inactive or get rid of it (db-close-query query))) -(defmethod db-map-bind-query ((query odbc-query) type function - &rest parameters) +(defun db-map-bind-query (query type function + &rest parameters) (declare (ignore type)) ; preliminary. Do a type coersion here (unwind-protect (progn @@ -494,10 +555,10 @@ This makes the functions db-execute-command and db-query thread safe." (ecase sql-type ((#.odbc::$SQL_CHAR #.odbc::$SQL_VARCHAR #.odbc::$SQL_LONGVARCHAR) :string) ((#.odbc::$SQL_NUMERIC #.odbc::$SQL_DECIMAL #.odbc::$SQL_BIGINT) :string) ; ?? - (#.odbc::$SQL_INTEGER :long) + (#.odbc::$SQL_INTEGER #.odbc::$ODBC-LONG-TYPE) (#.odbc::$SQL_SMALLINT :short) - ((#.odbc::$SQL_FLOAT #.odbc::$SQL_DOUBLE) :long) - (#.odbc::$SQL_REAL :long) + ((#.odbc::$SQL_FLOAT #.odbc::$SQL_DOUBLE) #.odbc::$ODBC-LONG-TYPE) + (#.odbc::$SQL_REAL #.odbc::$ODBC-LONG-TYPE) (#.odbc::$SQL_DATE 'sql-c-date) (#.odbc::$SQL_TIME 'sql-c-time) (#.odbc::$SQL_TIMESTAMP 'sql-c-timestamp) @@ -523,10 +584,12 @@ This makes the functions db-execute-command and db-query thread safe." ;; support SQLDescribeParam. To do: put code in here for drivers that do ;; support it. (unless (string-equal sql "insert" :end1 6) - (error "Only insert expressions are supported in literal ODBC: '~a'." sql)) + (error 'clsql:sql-database-error + (format nil + "Only insert expressions are supported in literal ODBC: '~a'." sql))) (%db-execute query (format nil "select ~{~a~^,~} from ~a where 0 = 1" (or parameter-columns '("*")) parameter-table)) - (%initialize-query query) + (%initialize-query query nil nil) (with-slots (hstmt) query (%free-statement hstmt :unbind) (%free-statement hstmt :reset) @@ -535,7 +598,7 @@ This makes the functions db-execute-command and db-query thread safe." query) -(defmethod %db-bind-execute ((query odbc-query) &rest parameters) +(defun %db-bind-execute (query &rest parameters) (with-slots (hstmt parameter-data-ptrs) query (loop for parameter in parameters with data-ptr and size and parameter-string @@ -552,7 +615,7 @@ This makes the functions db-execute-command and db-query thread safe." hstmt (1- (fill-pointer parameter-data-ptrs)) odbc::$SQL_PARAM_INPUT odbc::$SQL_C_CHAR ; (aref column-c-types parameter-count) odbc::$SQL_CHAR ; sql-type - +max-precision+ ;precision ; this should be the actual precision! + (query-width query) ;precision ; this should be the actual precision! ;; scale 0 ;; should be calculated for odbc::$SQL_DECIMAL, ;;$SQL_NUMERIC and odbc::$SQL_TIMESTAMP @@ -560,16 +623,15 @@ This makes the functions db-execute-command and db-query thread safe." 0 ;; *pcbValue; ;; change this for output and binary input! (see 3-32) - (%null-ptr)) + +null-ptr+) (%put-str data-ptr parameter-string size)) (%sql-execute hstmt))) -(defmethod %db-reset-query ((query odbc-query)) +(defun %db-reset-query (query) (with-slots (hstmt parameter-data-ptrs) query (prog1 - (db-fetch-query-results query nil ; flatp - nil) + (db-fetch-query-results query nil) (%free-statement hstmt :reset) ;; but _not_ :unbind ! (%free-statement hstmt :close) (dotimes (param-nr (fill-pointer parameter-data-ptrs)) @@ -578,7 +640,7 @@ This makes the functions db-execute-command and db-query thread safe." (setf (fill-pointer parameter-data-ptrs) 0)))) (defun data-parameter-ptr (hstmt) - (uffi:with-foreign-object (param-ptr (* :pointer-void)) + (uffi:with-foreign-object (param-ptr :pointer-void) (let ((return-code (%sql-param-data hstmt param-ptr))) ;;(format t "~%return-code from %sql-param-data: ~a~%" return-code) (when (= return-code odbc::$SQL_NEED_DATA) @@ -587,8 +649,8 @@ This makes the functions db-execute-command and db-query thread safe." ;; database inquiery functions -(defmethod db-describe-columns ((database odbc-db) - table-qualifier table-owner table-name column-name) +(defun db-describe-columns (database table-qualifier table-owner + table-name column-name) (with-slots (hdbc) database (%describe-columns hdbc table-qualifier table-owner table-name column-name))) @@ -603,7 +665,9 @@ This makes the functions db-execute-command and db-query thread safe." (defmethod get-odbc-info ((query odbc-query) info-type) (get-odbc-info (odbc::query-database query) info-type)) -;; driver inquiery +;; driver inquiry +;; How does this differ from list-data-sources? +(defgeneric db-data-sources (db-type)) (defmethod db-data-sources ((db-type (eql :odbc))) "Returns a list of (data-source description) - pairs" (let ((henv (%new-environment-handle))) @@ -615,5 +679,3 @@ This makes the functions db-execute-command and db-query thread safe." collect data-source+description do (setf direction :next)) (%sql-free-environment henv)))) - -; EOF