;;;; 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
;;;;
#:run-prepared-sql
#:set-autocommit
#:sql
-
+
#:*auto-trim-strings*
#:*default-database*
#:*default-odbc-external-format*
(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 ()
(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)
+ :accessor column-names)
(column-c-types :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t)
- :accessor column-c-types)
+ :accessor column-c-types)
(column-sql-types :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t)
- :accessor column-sql-types)
+ :accessor column-sql-types)
(column-data-ptrs :initform (make-array 0 :adjustable t :fill-pointer t)
- :accessor data-ptrs)
+ :accessor data-ptrs)
(column-out-len-ptrs :initform (make-array 0 :adjustable t :fill-pointer t)
- :accessor column-out-len-ptrs)
+ :accessor column-out-len-ptrs)
(column-precisions :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t)
- :accessor column-precisions)
+ :accessor column-precisions)
(column-scales :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t)
- :accessor column-scales)
+ :accessor column-scales)
(column-nullables-p :initform (make-array 0 :element-type 'fixnum :adjustable t :fill-pointer t)
- :accessor column-nullables-p)
+ :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)
+ :accessor parameter-ptrs)
;; a query string or a query expression object
(sql-expression :initform nil :initarg :sql-expression :accessor sql-expression)
;; database object the query is to be run against
;;; AODBC Compatible interface
-(defun connect (&key data-source-name user password (autocommit t))
+(defun connect (&key data-source-name user password connection-string completion window-handle (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)
+ (if connection-string
+ (%sql-driver-connect (hdbc db)
+ connection-string
+ (ecase completion
+ (:no-prompt odbc::$SQL_DRIVER_NOPROMPT)
+ (:complete odbc::$SQL_DRIVER_COMPLETE)
+ (:prompt odbc::$SQL_DRIVER_PROMPT)
+ (:complete-required odbc::$SQL_DRIVER_COMPLETE_REQUIRED))
+ window-handle)
+ (%sql-connect (hdbc db) data-source-name user password))
#+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))
- (disable-autocommit (hdbc db))))
+ (enable-autocommit (hdbc db))
+ (disable-autocommit (hdbc db))))
db))
(defun disconnect (database)
(with-slots (hdbc queries) database
(dolist (query queries)
(if (query-active-p query)
- (with-slots (hstmt) query
- (when hstmt
- (%free-statement hstmt :drop)
- (setf hstmt nil)))))
+ (with-slots (hstmt) query
+ (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 t) query
- hstmt width)
+(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)))
+ (values q (column-names q))
+ q)))
(t
(multiple-value-bind (data col-names)
- (db-query db expr :result-types result-types :width width)
+ (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))))))
+ (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)
((zerop count)
(close-query query)
(when eof-errorp
- (error 'clsql-odbc-error :odbc-message "Ran out of data in fetch-row"))
+ (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))
(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))))
+ (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))))
+ (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 ""))
+ (db-describe-columns db nil nil table nil)) ;; use nil rather than "" for unspecified values
(defun list-all-data-sources ()
(let ((db (make-instance 'odbc-db)))
;;; Mid-level interface
-(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)))
(:henv (henv ,*default-database*) :hdbc (hdbc ,*default-database*))
,@body))
-(defmethod initialize-instance :after ((query odbc-query)
+(defmethod initialize-instance :after ((query odbc-query)
&key sql henv hdbc &allow-other-keys)
(when sql
(let ((hstmt (%new-statement-handle hdbc)))
(%sql-exec-direct sql hstmt henv hdbc)
- (with-slots (column-count
- column-names column-c-types column-sql-types column-data-ptrs
+ (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 active-p) query
(setf (hstmt query) hstmt)
(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))
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 result-types width
- &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
- :result-types result-types
- :width (if width width (db-width database))))
+ :result-types result-types
+ :width (if width width (db-width database))))
(defmethod db-open-query ((query odbc-query) query-expression
- &key arglen col-positions result-types width
- &allow-other-keys)
+ &key arglen col-positions result-types width
+ &allow-other-keys)
(%db-execute query query-expression)
(%initialize-query query arglen col-positions :result-types result-types
- :width width))
+ :width width))
(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)
(when (query-active-p 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
+ (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)))))
-
-(defmethod db-query ((database odbc-db) query-expression &key result-types width)
+ (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 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)
- (column-names free-query))
- (values
- (result-rows-count (hstmt free-query))
- nil)))
+ (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)
)))
(defmethod %db-execute ((query odbc-query) sql-expression &key &allow-other-keys)
(with-slots (henv hdbc) (odbc::query-database query)
(with-slots (hstmt) query
- (unless hstmt (setf hstmt (%new-statement-handle hdbc)))
+ (unless hstmt (setf hstmt (%new-statement-handle hdbc)))
(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 hdbc) database
- (or (clsql-base-sys:without-interrupts
+ (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
- width hstmt
- column-sql-types column-data-ptrs
- column-out-len-ptrs column-precisions
- column-scales column-nullables-p)
+ (when inactive-query
+ (with-slots (column-count column-names column-c-types
+ 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)
+ 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
(defmethod db-execute-command ((query odbc-query) sql-string)
(with-slots (hstmt database) query
(with-slots (henv hdbc) database
- (unless hstmt (setf hstmt (%new-statement-handle hdbc)))
- (unwind-protect
+ (unless hstmt (setf hstmt (%new-statement-handle hdbc)))
+ (unwind-protect
(%sql-exec-direct sql-string hstmt henv hdbc)
(db-close-query query)))))
(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))))
+ :result-types result-types
+ :width (if width width (db-width database))))
(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
+ column-scales column-nullables-p)
+ query
(setf column-count (if arglen
(min arglen (result-columns-count hstmt))
(result-columns-count hstmt)))
;; allocate space to bind result rows to
(multiple-value-bind (c-type data-ptr out-len-ptr size long-p)
(%allocate-bindings sql-type precision)
- (unless long-p ;; if long-p we fetch in chunks with %sql-get-data
+ (if long-p ;; if long-p we fetch in chunks with %sql-get-data but must ensure that out_len_ptr is non zero
+ (setf (uffi:deref-pointer out-len-ptr #.odbc::$ODBC-LONG-TYPE) #.odbc::$SQL_NO_TOTAL)
(%bind-column hstmt col-nr c-type data-ptr (1+ size) out-len-ptr))
- (vector-push-extend name column-names)
+ (vector-push-extend name column-names)
(vector-push-extend sql-type column-sql-types)
(vector-push-extend (sql-to-c-type sql-type) column-c-types)
(vector-push-extend precision column-precisions)
(dotimes (col-nr column-count)
;; get column information
(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_BIGINT :short)
- (t t))))
- (t
- t)))))
+ (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
(dotimes (col-nr count)
(let ((data-ptr (aref column-data-ptrs col-nr))
(out-len-ptr (aref column-out-len-ptrs col-nr)))
- ;; 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)))))
+ (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
(%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
- computed-result-types)
+ (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 (= (SQLFetch hstmt) odbc::$SQL_NO_DATA_FOUND)
+ (unless (= (odbc::SQLFetch hstmt) odbc::$SQL_NO_DATA_FOUND)
(values
- (loop for col-nr from 0 to (- column-count
+ (loop for col-nr from 0 to (- column-count
(if (eq ignore-columns :last) 2 1))
- for result-type across computed-result-types
- 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 (query-width query))
(and (zerop precision) (not (find sql-type '($SQL_C_CHAR)))))
- (read-data (aref column-data-ptrs col-nr)
+ (read-data (aref column-data-ptrs col-nr)
(aref column-c-types col-nr)
sql-type
(aref column-out-len-ptrs col-nr)
*null*)
(t
(read-data-in-chunks hstmt col-nr
- (aref column-data-ptrs col-nr)
+ (aref column-data-ptrs col-nr)
(aref column-c-types col-nr)
(aref column-sql-types col-nr)
(aref column-out-len-ptrs col-nr)
;; 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
(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_DATE 'sql-c-date)
- (#.odbc::$SQL_TIME 'sql-c-time)
- (#.odbc::$SQL_TIMESTAMP 'sql-c-timestamp)
+ ((#.odbc::$SQL_FLOAT #.odbc::$SQL_DOUBLE) #.odbc::$ODBC-LONG-TYPE)
+ (#.odbc::$SQL_REAL #.odbc::$ODBC-LONG-TYPE)
+ ((#.odbc::$SQL_DATE #.odbc::$SQL_TYPE_DATE) 'sql-c-date)
+ ((#.odbc::$SQL_TIME #.odbc::$SQL_TYPE_TIME) 'sql-c-time)
+ ((#.odbc::$SQL_TIMESTAMP #.odbc::$SQL_TYPE_TIMESTAMP) 'sql-c-timestamp)
;;((#.odbc::$SQL_BINARY #.odbc::$SQL_VARBINARY #.odbc::$SQL_LONGVARBINARY) odbc::$SQL_C_BINARY) ; ??
(#.odbc::$SQL_TINYINT :short)
;;(#.odbc::$SQL_BIT odbc::$SQL_C_BIT) ; ??
(defmethod db-prepare-statement ((database odbc-db) sql
&key parameter-table parameter-columns)
(with-slots (hdbc) database
- (let ((query (get-free-query database)))
+ (let ((query (get-free-query database)))
(with-slots (hstmt) query
(unless hstmt (setf hstmt (%new-statement-handle hdbc))))
(db-prepare-statement query sql parameter-table parameter-columns))))
;; 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 nil nil)
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
parameter
(write-to-string parameter))
size (length parameter-string)
- data-ptr
+ data-ptr
(uffi:allocate-foreign-string (1+ size)))
(vector-push-extend data-ptr parameter-data-ptrs)
- (%sql-bind-parameter
+ (%sql-bind-parameter
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
- (query-width query) ;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
(%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)
+ (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))
;; 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)))
-;; should translate info-type integers to keywords in order to make this
+;; should translate info-type integers to keywords in order to make this
;; more readable?
(defmethod get-odbc-info ((database odbc-db) info-type)
(with-slots (hdbc info) database
(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)))
(unwind-protect
(loop with direction = :first
- for data-source+description
+ for data-source+description
= (multiple-value-list (%sql-data-sources henv :direction direction))
while (car data-source+description)
collect data-source+description
do (setf direction :next))
(%sql-free-environment henv))))
-
-; EOF
projects / clsql.git / blobdiff