;;;; 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
;;;;
;;; 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
((zerop count)
(close-query query)
(when eof-errorp
- (error 'sql-database-data-error
+ (error 'clsql:sql-database-data-error
:message "ODBC: Ran out of data in fetch-row"))
eof-value)
(t
(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)))
;; 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 sql-type column-sql-types)
(#.odbc::$SQL_SMALLINT :short)
((#.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)
+ ((#.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) ; ??
;; 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)