(defun handle-error (henv hdbc hstmt)
(let ((sql-state (allocate-foreign-string 256))
(error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH)))
(defun handle-error (henv hdbc hstmt)
(let ((sql-state (allocate-foreign-string 256))
(error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH)))
(defun sql-state (henv hdbc hstmt)
(let ((sql-state (allocate-foreign-string 256))
(error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH)))
(defun sql-state (henv hdbc hstmt)
(let ((sql-state (allocate-foreign-string 256))
(error-message (allocate-foreign-string #.$SQL_MAX_MESSAGE_LENGTH)))
(or ,hdbc +null-handle-ptr+)
(or ,hstmt +null-handle-ptr+))
(error
(or ,hdbc +null-handle-ptr+)
(or ,hstmt +null-handle-ptr+))
(error
- (with-foreign-object (hstmt-ptr 'sql-handle)
- (with-error-handling
- (:hdbc hdbc)
- (SQLAllocStmt hdbc hstmt-ptr)
- (deref-pointer hstmt-ptr 'sql-handle))))
-
+ (let ((statement-handle
+ (with-foreign-object (hstmt-ptr 'sql-handle)
+ (with-error-handling
+ (:hdbc hdbc)
+ (SQLAllocStmt hdbc hstmt-ptr)
+ (deref-pointer hstmt-ptr 'sql-handle)))))
+ (if (uffi:null-pointer-p statement-handle)
+ (error "Received null statement handle.")
+ statement-handle)))
+
;; column counting is 1-based
(defun %describe-column (hstmt column-nr)
(let ((column-name-ptr (allocate-foreign-string 256)))
(with-foreign-objects ((column-name-length-ptr :short)
(column-sql-type-ptr :short)
;; column counting is 1-based
(defun %describe-column (hstmt column-nr)
(let ((column-name-ptr (allocate-foreign-string 256)))
(with-foreign-objects ((column-name-length-ptr :short)
(column-sql-type-ptr :short)
(column-scale-ptr :short)
(column-nullable-p-ptr :short))
(with-error-handling (:hstmt hstmt)
(column-scale-ptr :short)
(column-nullable-p-ptr :short))
(with-error-handling (:hstmt hstmt)
(deref-pointer column-scale-ptr :short)
(deref-pointer column-nullable-p-ptr :short)))))))
;; parameter counting is 1-based
(defun %describe-parameter (hstmt parameter-nr)
(with-foreign-objects ((column-sql-type-ptr :short)
(deref-pointer column-scale-ptr :short)
(deref-pointer column-nullable-p-ptr :short)))))))
;; parameter counting is 1-based
(defun %describe-parameter (hstmt parameter-nr)
(with-foreign-objects ((column-sql-type-ptr :short)
(deref-pointer column-scale-ptr :short)
(deref-pointer column-nullable-p-ptr :short)))))
(defun %column-attributes (hstmt column-nr descriptor-type)
(let ((descriptor-info-ptr (allocate-foreign-string 256)))
(with-foreign-objects ((descriptor-length-ptr :short)
(deref-pointer column-scale-ptr :short)
(deref-pointer column-nullable-p-ptr :short)))))
(defun %column-attributes (hstmt column-nr descriptor-type)
(let ((descriptor-info-ptr (allocate-foreign-string 256)))
(with-foreign-objects ((descriptor-length-ptr :short)
(def-type byte-pointer-type '(* :byte))
(def-type short-pointer-type '(* :short))
(def-type int-pointer-type '(* :int))
(def-type byte-pointer-type '(* :byte))
(def-type short-pointer-type '(* :short))
(def-type int-pointer-type '(* :int))
(def-type float-pointer-type '(* :float))
(def-type double-pointer-type '(* :double))
(def-type string-pointer-type '(* :unsigned-char))
(def-type float-pointer-type '(* :float))
(def-type double-pointer-type '(* :double))
(def-type string-pointer-type '(* :unsigned-char))
(defun read-data (data-ptr c-type sql-type out-len-ptr result-type)
(declare (type long-ptr-type out-len-ptr))
(defun read-data (data-ptr c-type sql-type out-len-ptr result-type)
(declare (type long-ptr-type out-len-ptr))
;; FIXME: this could be better optimized for types which use READ-FROM-STRING above
(if (and (or (eq result-type t) (eq result-type :string))
;; FIXME: this could be better optimized for types which use READ-FROM-STRING above
(if (and (or (eq result-type t) (eq result-type :string))
(#.$SQL_C_DATE (allocate-foreign-object 'sql-c-date))
(#.$SQL_C_TIME (allocate-foreign-object 'sql-c-time))
(#.$SQL_C_TIMESTAMP (allocate-foreign-object 'sql-c-timestamp))
(#.$SQL_C_FLOAT (uffi:allocate-foreign-object :float))
(#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double))
(#.$SQL_C_BIT (uffi:allocate-foreign-object :byte))
(#.$SQL_C_DATE (allocate-foreign-object 'sql-c-date))
(#.$SQL_C_TIME (allocate-foreign-object 'sql-c-time))
(#.$SQL_C_TIMESTAMP (allocate-foreign-object 'sql-c-timestamp))
(#.$SQL_C_FLOAT (uffi:allocate-foreign-object :float))
(#.$SQL_C_DOUBLE (uffi:allocate-foreign-object :double))
(#.$SQL_C_BIT (uffi:allocate-foreign-object :byte))
(#.$SQL_C_SSHORT (uffi:allocate-foreign-object :short))
(#.$SQL_C_CHAR (uffi:allocate-foreign-string (1+ size)))
(#.$SQL_C_BINARY (uffi:allocate-foreign-string (1+ (* 2 size))))
(#.$SQL_C_SSHORT (uffi:allocate-foreign-object :short))
(#.$SQL_C_CHAR (uffi:allocate-foreign-string (1+ size)))
(#.$SQL_C_BINARY (uffi:allocate-foreign-string (1+ (* 2 size))))
(break "SQL type is ~A, precision ~D, size ~D, C type is ~A"
sql-type precision size c-type))
(uffi:allocate-foreign-object :byte (1+ size)))))
(break "SQL type is ~A, precision ~D, size ~D, C type is ~A"
sql-type precision size c-type))
(uffi:allocate-foreign-object :byte (1+ size)))))
(values c-type data-ptr out-len-ptr size long-p)))
(defun fetch-all-rows (hstmt &key free-option flatp)
(values c-type data-ptr out-len-ptr size long-p)))
(defun fetch-all-rows (hstmt &key free-option flatp)
;; depending on option, we return a long int or a string; string not implemented
(defun get-connection-option (hdbc option)
;; depending on option, we return a long int or a string; string not implemented
(defun get-connection-option (hdbc option)
(declare (type long-ptr-type out-len-ptr))
(let* ((res (%sql-get-data hstmt column-nr c-type data-ptr
+max-precision+ out-len-ptr))
(declare (type long-ptr-type out-len-ptr))
(let* ((res (%sql-get-data hstmt column-nr c-type data-ptr
+max-precision+ out-len-ptr))